home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / pager2.zip / PAGER2.SRC < prev   
Text File  |  1989-06-16  |  106KB  |  3,274 lines

  1. --::::::::::
  2. --pager2.inc
  3. --::::::::::
  4. -- Include file for PAGER2 Release
  5. pager2.inc
  6.  
  7. -- Documentation on PAGER2 (PRF file is raw ASCII, DOC file is formatted)
  8. pager2.prf
  9. pager2.doc
  10.  
  11. -- The package spec to CLI
  12. cli.ada
  13. -- Select one of these package
  14. -- bodies, depending on your compiler
  15. cli_alsys.ada
  16. cli_cais.ada
  17. cli_general.ada
  18. cli_integr.ada
  19. cli_verdix.ada
  20. cli_vms.ada
  21.  
  22. -- Source code in Ada for PAGER2
  23. pager2.ada
  24. --::::::::::
  25. --pager2.prf
  26. --::::::::::
  27. .lm 10
  28. .rm 70
  29. .ce 100
  30. PAGER2
  31.  
  32. by Richard Conn
  33. .ce 0
  34. .he //PAGER2//
  35. .fo /Richard Conn//Page #/
  36. .de LIST
  37. .nr c 0
  38. .in +8
  39. .rm -8
  40. .en
  41. .de ELIST
  42. .rm +8
  43. .in -8
  44. .en
  45. .de LE
  46. .sp 1
  47. .ti -2
  48. .nr c +1
  49. @nc.
  50. .en
  51. .de section
  52. .sp 4
  53. .ne 10
  54. .nr a +1
  55. .nr b 0
  56. @na.
  57. .en
  58. .de subsection
  59. .sp 2
  60. .ne 10
  61. .nr b +1
  62. @na.@nb.
  63. .en
  64. .nr a 0
  65. .de PP
  66. .sp 1
  67. .ti +5
  68. .en
  69. .in +3
  70. .rm -3
  71. .PP
  72. PAGER2 is a tool for creating paged files, extracting the
  73. component files from a paged file, and scanning paged
  74. files,  where  a  paged  file  is a file composed of one or more files
  75. prefixed by banners.  PAGER2 is based in concept  on  the  UNPAGE  tool
  76. submitted to the Ada Software Repository on SIMTEL20 by Mitre Corporation.
  77. .PP
  78. Paged files are convenient mechanisms for storing related  files.
  79. They  reduce  cluttering  in  the  directories  and  simplify the file
  80. transfer process by
  81. requiring  the  user  to transfer only one file in order to obtain all
  82. files pertinent to a particular project or tool.  Additionally,  paged
  83. files  are text files which can be handled more readily than the 8-bit
  84. binary images associated with other file grouping mechanisms (see  the
  85. file   OILBR.DOC   in  the  directory  PD2:<ADA.GENERAL>  in  the  Ada
  86. Software Repository).  Paged files may be  manipulated  by  a  text  editor  if
  87. necessary.
  88. .PP
  89. For these reasons, paged files have been adopted  as  a  standard
  90. for  file  storage in the Ada Software Repository.  The file type of SRC (as in
  91. MYFILE.SRC) indicates that a file is paged.
  92. .rm +3
  93. .in -3
  94. .section
  95. PAGED FILE FORMAT
  96. .PP
  97. A paged file is a file composed of one or more files prefixed  by
  98. banners of the form:
  99. .sp 1
  100. .ne 10
  101. .nf
  102. .nj
  103.                 ::::::::::
  104.                 filename
  105.                 ::::::::::
  106. or
  107.                 --::::::::::
  108.                 --filename
  109.                 --::::::::::
  110. .ju
  111. .fi
  112. .PP
  113. The first banner conforms to the PAGE standard employed on  UNIX.
  114. The  second  banner is an adaptation of the first form which resembles
  115. Ada comments.  The second banner is convenient  when  the  paged  file
  116. contains  several  files  associated with a particular Ada program and
  117. they are placed in the paged file in compilation order.  The resulting
  118. paged file may then be compiled without being disassembled first.
  119. .section
  120. PAGER2 COMMANDS
  121. .PP
  122. PAGER2 responds to the following commands:
  123. .LIST
  124. .LE
  125. PAGE or P - create a paged file
  126. .LE
  127. UNPAGE or U - extract the components of a paged file into their separate files
  128. .LE
  129. LIST or L - list components of a paged file to the screen
  130. .LE
  131. INCLUDE or I - list components of a paged file into an include file
  132. .LE
  133. HELP or H - print a command summary
  134. .LE
  135. EXIT or X - exit PAGER2
  136. .ELIST
  137. .PP
  138. The case used to enter these command verbs is not significant.  The case
  139. used to enter the file names referenced as arguments to the command verbs
  140. is significant if the host operating system distinguishes case in file names,
  141. as does UNIX (but not MSDOS).
  142. .subsection
  143. PAGE Command
  144. .PP
  145. The PAGE function is used to created a paged  file  from  one  or
  146. more component files.  The syntax of the PAGE command is:
  147. .sp 1
  148. .nf
  149. .nj
  150.      PAGE [filename | @include__filename]+ paged__file__name
  151. .ju
  152. .fi
  153. .PP
  154. Two or more file names
  155. may be specified after the PAGE verb.  The last
  156. file name is the name of the paged file to be created.  The other file names
  157. are the names of files to be placed into the paged file or the names of
  158. include files from which the names of files to be placed into the paged file
  159. are to be extracted.
  160. .PP
  161. If the user prefixes the name of a component file with an  atsign
  162. character (_@), the indicated file is processed as an include file.  An
  163. include file is a file which  contains  the  names  of  zero  or  more
  164. component  files,  one  name  per  line  starting in the first column.
  165. Other include files may  be  referenced  within  an  include  file  by
  166. prefixing  their  names  with  the  atsign character.  Comments may be
  167. placed within an include file by placing two dashes in the  first  two
  168. columns of a line.  The following is an example of an include file:
  169. .sp 1
  170. .ne 15
  171. .nf
  172. .nj
  173.          Example                      Comments
  174.          =======                      ========
  175. --
  176. -- This is an include file for        Comment at the beginning
  177. --  my favorite tool
  178. --
  179.                                       Blank lines are allowed
  180. --
  181. -- The following include file
  182. --  contains the names of the         Another comment
  183. --  Ada source files in compilation
  184. --  order
  185. --
  186. @mytool.cmp
  187. --
  188. -- The following are the documentation
  189. --  files
  190. --
  191. mytool.ref
  192. mytool.doc
  193. mytool.idx
  194. .fi
  195. .ju
  196. .PP
  197. A single letter "P" may be used rather than the full "PAGE" verb.
  198. An example of the execution of the PAGE command is:
  199. .sp 1
  200. .ne 8
  201. .nf
  202. .nj
  203. PAGER2> page
  204.  PAGE Command requires the name of the paged file and include file
  205.    Syntax: page [@include__file__name|file__name]+ paged__file__name
  206. PAGER2> p @demo.inc demo.src
  207.  Adding demo.inc -- 8 Lines
  208.  Adding demo1.txt -- 1 Lines
  209.  Adding demo2.txt -- 1 Lines
  210. .ju
  211. .fi
  212. .subsection
  213. UNPAGE Command
  214. .PP
  215. The UNPAGE function extracts the  components  from  the  indicated
  216. paged  file,  leaving  the  original paged file intact.  The syntax of
  217. UNPAGE is:
  218. .sp 1
  219. .nf
  220. .nj
  221.     UNPAGE paged__filename
  222. .ju
  223. .fi
  224. .PP
  225. The single letter "U" may be used rather than the full "UNPAGE" verb.
  226. An example of the execution of the UNPAGE command is:
  227. .sp 1
  228. .ne 8
  229. .nf
  230. .nj
  231. PAGER2> unpage
  232.  UNPAGE Command requires the name of a paged file
  233.    Syntax: unpage paged__file__name
  234. PAGER2> u demo.src
  235.  Extracting demo.inc -- 8 Lines
  236.  Extracting demo1.txt -- 1 Lines
  237.  Extracting demo2.txt -- 1 Lines
  238. .ju
  239. .fi
  240. .subsection
  241. LIST Command
  242. .PP
  243. The LIST function is used to create a text  file  containing  the
  244. names  of  the component files within a paged file.  The syntax of the
  245. LIST command is:
  246. .sp 1
  247. .nf
  248. .nj
  249.      LIST paged__file__name
  250. .ju
  251. .fi
  252. .PP
  253. The single letter "L" may be used rather than the full "LIST" verb.
  254. An example of the execution of the LIST command is:
  255. .sp 1
  256. .ne 8
  257. .nf
  258. .nj
  259. PAGER2> list
  260.  LIST Command requires the name of a paged file
  261.    Syntax: list paged__file__name
  262. PAGER2> list demo.src
  263.  demo.inc -- 8 Lines
  264.  demo1.txt -- 1 Lines
  265.  demo2.txt -- 1 Lines
  266. .ju
  267. .fi
  268. .subsection
  269. INCLUDE Command
  270. .PP
  271. The INCLUDE command performs the same function of the LIST command, but
  272. it places the output into an include file which is suitable for building
  273. a new paged file.  Its syntax is:
  274. .sp 1
  275. .nf
  276. .nj
  277.     INCLUDE paged__file__name include__file__name
  278. .ju
  279. .fi
  280. .PP
  281. The single letter "I" may be used rather than the full "INCLUDE" verb.
  282. An example of the execution of the INCLUDE command is:
  283. .sp 1
  284. .ne 8
  285. .nf
  286. .nj
  287. PAGER2> include
  288.  INCLUDE Command requires the name of a paged file
  289.    Syntax: include paged__file__name output__include__file
  290. PAGER2> include demo.src demo2.inc
  291.  demo.inc -- 8 Lines
  292.  demo1.txt -- 1 Lines
  293.  demo2.txt -- 1 Lines
  294. .ju
  295. .fi
  296. .subsection
  297. HELP Command
  298. .PP
  299. The HELP command displays a brief help text  to  the  user.   The
  300. syntax of this command is:
  301. .sp 1
  302. .nf
  303. .nj
  304.     HELP
  305. .ju
  306. .fi
  307. .PP
  308. The single letter "H" may be used rather than the full "HELP" verb.
  309. .subsection
  310. EXIT Command
  311. .PP
  312. The EXIT command exits PAGER.  Its syntax is:
  313. .sp 1
  314. .nf
  315. .nj
  316.     EXIT
  317. .ju
  318. .fi
  319. .PP
  320. The single letter "X" may be used rather than the full "EXIT" verb.
  321. .section
  322. INVOKING PAGER2 FROM THE COMMAND LINE
  323. .PP
  324. PAGER2 may also be run from the command line.  The PAGER2 verb may be followed
  325. by a conventional PAGER2 command, in which case the PAGER2 command alone will
  326. be executed and then PAGER2 will exit.  In addition, the verb recognized by
  327. PAGER2 (like HELP or UNPAGE) may be prefixed with a dash (-), making the syntax
  328. of the PAGER2 command line similar to a conventional UNIX command line.
  329. For example, to obtain a display of the brief help message, either of these
  330. commands may be used:
  331. .sp 1
  332. .ne 4
  333. .nf
  334. .nj
  335.     PAGER2 HELP
  336.     PAGER2 H
  337.     PAGER2 -H
  338.     PAGER2 -help
  339. .ju
  340. .fi
  341. .PP
  342. Likewise, to create a paged file, named MYFILES.SRC, from the component files
  343. FILE1.TXT, FILE2.TXT, and FILE3.TXT, a command like the following could be
  344. issued:
  345. .sp 1
  346. .ne 4
  347. .nf
  348. .nj
  349.     PAGER2 -PAGE FILE1.TXT FILE2.TXT FILE3.TXT MYFILES.SRC
  350. .ju
  351. .fi
  352. .section
  353. SAMPLE SESSION
  354. .PP
  355. The following is a sample PAGER2 session.  It was  run  on  a  SUN
  356. 3 Model 260 running SunOS 3.5.
  357. .sp 1
  358. .nf
  359. .nj
  360. ifsun0/xanadu> ls -l
  361. total 3
  362. -rw-r--r--  1 xanadu        166 Jun 16 10:23 demo.inc
  363. -rw-r--r--  1 xanadu         23 Jun 16 10:23 demo1.txt
  364. -rw-r--r--  1 xanadu         23 Jun 16 10:23 demo2.txt
  365.  
  366. ifsun0/xanadu> cat demo.inc
  367. -- This is a demonstration of the PAGER2 program
  368.  
  369. -- The include file is named DEMO.INC
  370. demo.inc
  371.  
  372. -- The source files are DEMO1.TXT and DEMO2.TXT
  373. demo1.txt
  374. demo2.txt
  375.  
  376. ifsun0/xanadu> cat demo1.txt
  377. This is file DEMO1.TXT
  378.  
  379. ifsun0/xanadu> cat demo2.txt
  380. This is file DEMO2.TXT
  381.  
  382. ifsun0/xanadu> pager2
  383. PAGER2, Ada Version 1.1
  384. Type 'h' for Help
  385.  
  386. PAGER2> page
  387.  PAGE Command requires the name of the paged file and include file
  388.    Syntax: page [@include_file_name|file_name]+ paged_file_name
  389.  
  390. PAGER2> p @demo.inc demo.src
  391.  Adding demo.inc -- 8 Lines
  392.  Adding demo1.txt -- 1 Lines
  393.  Adding demo2.txt -- 1 Lines
  394.  
  395. PAGER2> list
  396.  LIST Command requires the name of a paged file
  397.    Syntax: list paged_file_name
  398.  
  399. PAGER2> list demo.src
  400.  demo.inc -- 8 Lines
  401.  demo1.txt -- 1 Lines
  402.  demo2.txt -- 1 Lines
  403.  
  404. PAGER2> include
  405.  INCLUDE Command requires the name of a paged file
  406.    Syntax: include paged_file_name output_include_file
  407.  
  408. PAGER2> include demo.src demo2.inc
  409.  demo.inc -- 8 Lines
  410.  demo1.txt -- 1 Lines
  411.  demo2.txt -- 1 Lines
  412.  
  413. PAGER2> x
  414.  
  415. ifsun0/xanadu> cat demo.src
  416.   --::::::::::
  417.   --demo.inc
  418.   --::::::::::
  419. -- This is a demonstration of the PAGER2 program
  420.  
  421. -- The include file is named DEMO.INC
  422. demo.inc
  423.  
  424. -- The source files are DEMO1.TXT and DEMO2.TXT
  425. demo1.txt
  426. demo2.txt
  427.   --::::::::::
  428.   --demo1.txt
  429.   --::::::::::
  430. This is file DEMO1.TXT
  431.   --::::::::::
  432.   --demo2.txt
  433.   --::::::::::
  434. This is file DEMO2.TXT
  435.  
  436. ifsun0/xanadu> cat demo2.inc
  437. -- Include file for demo.src
  438. demo.inc
  439. demo1.txt
  440. demo2.txt
  441.  
  442. ifsun0/xanadu> pager2
  443. PAGER2, Ada Version 1.1
  444. Type 'h' for Help
  445.  
  446. PAGER2> u demo.src
  447.  Extracting demo.inc -- 8 Lines
  448.  Extracting demo1.txt -- 1 Lines
  449.  Extracting demo2.txt -- 1 Lines
  450.  
  451. PAGER2> unpage
  452.  UNPAGE Command requires the name of a paged file
  453.    Syntax: unpage paged_file_name
  454.  
  455. PAGER2> u demo.src
  456.  Extracting demo.inc -- 8 Lines
  457.  Extracting demo1.txt -- 1 Lines
  458.  Extracting demo2.txt -- 1 Lines
  459.  
  460. PAGER2> x
  461. ifsun0/xanadu> ls -l
  462. total 5
  463. -rw-r--r--  1 xanadu        166 Jun 16 10:26 demo.inc
  464. -rw-r--r--  1 xanadu        325 Jun 16 10:25 demo.src
  465. -rw-r--r--  1 xanadu         23 Jun 16 10:26 demo1.txt
  466. -rw-r--r--  1 xanadu         58 Jun 16 10:25 demo2.inc
  467. -rw-r--r--  1 xanadu         23 Jun 16 10:26 demo2.txt
  468.  
  469. .ju
  470. .fi
  471. --::::::::::
  472. --pager2.doc
  473. --::::::::::
  474.  
  475.  
  476.  
  477.  
  478.  
  479.                                      PAGER2
  480.  
  481.                                 by Richard Conn
  482.  
  483.                   PAGER2 is   a  tool  for  creating  paged  files,
  484.              extracting  the component files from a paged file, and
  485.              scanning  paged  files,   where   a  paged  file  is a
  486.              file  composed  of  one  or  more  files  prefixed  by
  487.              banners.    PAGER2   is  based  in  concept   on   the
  488.              UNPAGE   tool submitted to the Ada Software Repository
  489.              on SIMTEL20 by Mitre Corporation.  
  490.  
  491.                   Paged files   are   convenient   mechanisms   for
  492.              storing  related   files.   They   reduce   cluttering
  493.              in   the  directories  and  simplify the file transfer
  494.              process  by requiring  the  user  to transfer only one
  495.              file  in  order  to  obtain  all  files pertinent to a
  496.              particular  project  or  tool.   Additionally,   paged
  497.              files   are  text  files  which  can  be  handled more
  498.              readily  than  the 8-bit binary images associated with
  499.              other   file   grouping   mechanisms  (see   the  file
  500.              OILBR.DOC     in   the   directory   PD2:<ADA.GENERAL>
  501.              in   the   Ada  Software Repository).  Paged files may
  502.              be  manipulated  by  a  text  editor  if necessary.  
  503.  
  504.                   For these   reasons,   paged   files   have  been
  505.              adopted   as   a   standard  for  file  storage in the
  506.              Ada  Software Repository.  The file type of SRC (as in
  507.              MYFILE.SRC) indicates that a file is paged.  
  508.  
  509.  
  510.  
  511.  
  512.           1.  PAGED FILE FORMAT 
  513.  
  514.                A paged  file  is  a file composed of one or more files
  515.           prefixed  by banners of the form: 
  516.  
  517.                           ::::::::::
  518.                           filename
  519.                           ::::::::::
  520.           or
  521.                           --::::::::::
  522.                           --filename
  523.                           --::::::::::
  524.  
  525.                The first   banner   conforms   to  the  PAGE  standard
  526.           employed  on  UNIX.  The  second  banner is an adaptation of
  527.           the  first  form  which  resembles Ada comments.  The second
  528.           banner  is  convenient   when   the   paged   file  contains
  529.           several   files   associated  with  a particular Ada program
  530.           and  they  are  placed  in  the  paged  file  in compilation
  531.  
  532.  
  533.           Richard Conn                                          Page 1
  534.  
  535.  
  536.                                      PAGER2
  537.  
  538.  
  539.           order.   The  resulting  paged  file  may  then  be compiled
  540.           without being disassembled first.  
  541.  
  542.  
  543.  
  544.  
  545.           2.  PAGER2 COMMANDS 
  546.  
  547.                PAGER2 responds to the following commands: 
  548.  
  549.                 1.  PAGE or P - create a paged file 
  550.  
  551.                 2.  UNPAGE  or U - extract the components of a
  552.                   paged file into their separate files 
  553.  
  554.                 3.  LIST  or  L  -  list components of a paged
  555.                   file to the screen 
  556.  
  557.                 4.  INCLUDE  or I - list components of a paged
  558.                   file into an include file 
  559.  
  560.                 5.  HELP or H - print a command summary 
  561.  
  562.                 6.  EXIT or X - exit PAGER2 
  563.  
  564.                The case  used  to  enter  these  command  verbs is not
  565.           significant.    The  case  used  to  enter  the  file  names
  566.           referenced  as arguments to the command verbs is significant
  567.           if  the  host  operating  system  distinguishes case in file
  568.           names, as does UNIX (but not MSDOS).  
  569.  
  570.  
  571.           2.1.  PAGE Command 
  572.  
  573.                The PAGE  function  is  used  to  created a paged  file
  574.           from   one  or more component files.  The syntax of the PAGE
  575.           command is: 
  576.  
  577.                PAGE [filename | @include_filename]+ paged_file_name
  578.  
  579.                Two or  more file names may be specified after the PAGE
  580.           verb.   The  last file name is the name of the paged file to
  581.           be  created.  The other file names are the names of files to
  582.           be  placed into the paged file or the names of include files
  583.           from  which  the  names of files to be placed into the paged
  584.           file are to be extracted.  
  585.  
  586.                If the  user prefixes the name of a component file with
  587.           an   atsign  character  (@), the indicated file is processed
  588.           as  an  include  file.   An  include  file  is  a file which
  589.           contains   the   names  of  zero  or  more component  files,
  590.           one   name   per  line  starting in the first column.  Other
  591.  
  592.  
  593.           Richard Conn                                          Page 2
  594.  
  595.  
  596.                                      PAGER2
  597.  
  598.  
  599.           include  files  may   be   referenced   within   an  include
  600.           file    by   prefixing   their   names   with   the   atsign
  601.           character.   Comments  may  be placed within an include file
  602.           by  placing  two  dashes  in  the   first   two columns of a
  603.           line.  The following is an example of an include file: 
  604.  
  605.                    Example                      Comments
  606.                    =======                      ========
  607.           --
  608.           -- This is an include file for        Comment at the beginning
  609.           --  my favorite tool
  610.           --
  611.                                                 Blank lines are allowed
  612.           --
  613.           -- The following include file
  614.           --  contains the names of the         Another comment
  615.           --  Ada source files in compilation
  616.           --  order
  617.           --
  618.           @mytool.cmp
  619.           --
  620.           -- The following are the documentation
  621.           --  files
  622.           --
  623.           mytool.ref
  624.           mytool.doc
  625.           mytool.idx
  626.  
  627.                A single  letter  "P"  may be used rather than the full
  628.           "PAGE"  verb.   An  example  of  the  execution  of the PAGE
  629.           command is: 
  630.  
  631.           PAGER2> page
  632.            PAGE Command requires the name of the paged file and include file
  633.              Syntax: page [@include_file_name|file_name]+ paged_file_name
  634.           PAGER2> p @demo.inc demo.src
  635.            Adding demo.inc -- 8 Lines
  636.            Adding demo1.txt -- 1 Lines
  637.            Adding demo2.txt -- 1 Lines
  638.  
  639.  
  640.           2.2.  UNPAGE Command 
  641.  
  642.                The UNPAGE  function  extracts  the   components   from
  643.           the   indicated  paged   file,  leaving  the  original paged
  644.           file intact.  The syntax of UNPAGE is: 
  645.  
  646.               UNPAGE paged_filename
  647.  
  648.                The single  letter "U" may be used rather than the full
  649.           "UNPAGE"  verb.   An  example of the execution of the UNPAGE
  650.           command is: 
  651.  
  652.  
  653.           Richard Conn                                          Page 3
  654.  
  655.  
  656.                                      PAGER2
  657.  
  658.  
  659.           PAGER2> unpage
  660.            UNPAGE Command requires the name of a paged file
  661.              Syntax: unpage paged_file_name
  662.           PAGER2> u demo.src
  663.            Extracting demo.inc -- 8 Lines
  664.            Extracting demo1.txt -- 1 Lines
  665.            Extracting demo2.txt -- 1 Lines
  666.  
  667.  
  668.           2.3.  LIST Command 
  669.  
  670.                The LIST  function  is  used  to  create  a  text  file
  671.           containing   the  names   of   the  component files within a
  672.           paged file.  The syntax of the LIST command is: 
  673.  
  674.                LIST paged_file_name
  675.  
  676.                The single  letter "L" may be used rather than the full
  677.           "LIST"  verb.   An  example  of  the  execution  of the LIST
  678.           command is: 
  679.  
  680.           PAGER2> list
  681.            LIST Command requires the name of a paged file
  682.              Syntax: list paged_file_name
  683.           PAGER2> list demo.src
  684.            demo.inc -- 8 Lines
  685.            demo1.txt -- 1 Lines
  686.            demo2.txt -- 1 Lines
  687.  
  688.  
  689.           2.4.  INCLUDE Command 
  690.  
  691.                The INCLUDE  command  performs the same function of the
  692.           LIST  command, but it places the output into an include file
  693.           which  is  suitable  for  building  a  new  paged file.  Its
  694.           syntax is: 
  695.  
  696.               INCLUDE paged_file_name include_file_name
  697.  
  698.                The single  letter "I" may be used rather than the full
  699.           "INCLUDE"  verb.  An example of the execution of the INCLUDE
  700.           command is: 
  701.  
  702.           PAGER2> include
  703.            INCLUDE Command requires the name of a paged file
  704.              Syntax: include paged_file_name output_include_file
  705.           PAGER2> include demo.src demo2.inc
  706.            demo.inc -- 8 Lines
  707.            demo1.txt -- 1 Lines
  708.            demo2.txt -- 1 Lines
  709.  
  710.  
  711.  
  712.  
  713.           Richard Conn                                          Page 4
  714.  
  715.  
  716.                                      PAGER2
  717.  
  718.  
  719.           2.5.  HELP Command 
  720.  
  721.                The HELP  command  displays  a brief help text  to  the
  722.           user.   The syntax of this command is: 
  723.  
  724.               HELP
  725.  
  726.                The single  letter "H" may be used rather than the full
  727.           "HELP" verb.  
  728.  
  729.  
  730.           2.6.  EXIT Command 
  731.  
  732.                The EXIT command exits PAGER.  Its syntax is: 
  733.  
  734.               EXIT
  735.  
  736.                The single  letter "X" may be used rather than the full
  737.           "EXIT" verb.  
  738.  
  739.  
  740.  
  741.  
  742.           3.  INVOKING PAGER2 FROM THE COMMAND LINE 
  743.  
  744.                PAGER2 may  also  be  run  from  the command line.  The
  745.           PAGER2  verb  may  be  followed  by  a  conventional  PAGER2
  746.           command,  in  which  case  the  PAGER2 command alone will be
  747.           executed  and  then PAGER2 will exit.  In addition, the verb
  748.           recognized  by  PAGER2 (like HELP or UNPAGE) may be prefixed
  749.           with  a  dash  (-),  making the syntax of the PAGER2 command
  750.           line  similar  to  a  conventional  UNIX  command line.  For
  751.           example,  to  obtain  a  display  of the brief help message,
  752.           either of these commands may be used: 
  753.  
  754.               PAGER2 HELP
  755.               PAGER2 H
  756.               PAGER2 -H
  757.               PAGER2 -help
  758.  
  759.                Likewise, to  create  a  paged file, named MYFILES.SRC,
  760.           from   the   component   files   FILE1.TXT,  FILE2.TXT,  and
  761.           FILE3.TXT, a command like the following could be issued: 
  762.  
  763.               PAGER2 -PAGE FILE1.TXT FILE2.TXT FILE3.TXT MYFILES.SRC
  764.  
  765.  
  766.  
  767.  
  768.  
  769.  
  770.  
  771.  
  772.  
  773.           Richard Conn                                          Page 5
  774.  
  775.  
  776.                                      PAGER2
  777.  
  778.  
  779.           4.  SAMPLE SESSION 
  780.  
  781.                The following  is  a  sample  PAGER2  session.   It was
  782.           run  on  a  SUN 3 Model 260 running SunOS 3.5.  
  783.  
  784.           ifsun0/xanadu> ls -l
  785.           total 3
  786.           -rw-r--r--  1 xanadu        166 Jun 16 10:23 demo.inc
  787.           -rw-r--r--  1 xanadu         23 Jun 16 10:23 demo1.txt
  788.           -rw-r--r--  1 xanadu         23 Jun 16 10:23 demo2.txt
  789.  
  790.           ifsun0/xanadu> cat demo.inc
  791.           -- This is a demonstration of the PAGER2 program
  792.  
  793.           -- The include file is named DEMO.INC
  794.           demo.inc
  795.  
  796.           -- The source files are DEMO1.TXT and DEMO2.TXT
  797.           demo1.txt
  798.           demo2.txt
  799.  
  800.           ifsun0/xanadu> cat demo1.txt
  801.           This is file DEMO1.TXT
  802.  
  803.           ifsun0/xanadu> cat demo2.txt
  804.           This is file DEMO2.TXT
  805.  
  806.           ifsun0/xanadu> pager2
  807.           PAGER2, Ada Version 1.1
  808.           Type 'h' for Help
  809.  
  810.           PAGER2> page
  811.            PAGE Command requires the name of the paged file and include file
  812.              Syntax: page [@includefilename|filename]+ pagedfilename
  813.  
  814.           PAGER2> p @demo.inc demo.src
  815.            Adding demo.inc -- 8 Lines
  816.            Adding demo1.txt -- 1 Lines
  817.            Adding demo2.txt -- 1 Lines
  818.  
  819.           PAGER2> list
  820.            LIST Command requires the name of a paged file
  821.              Syntax: list pagedfilename
  822.  
  823.           PAGER2> list demo.src
  824.            demo.inc -- 8 Lines
  825.            demo1.txt -- 1 Lines
  826.            demo2.txt -- 1 Lines
  827.  
  828.           PAGER2> include
  829.            INCLUDE Command requires the name of a paged file
  830.              Syntax: include pagedfilename outputincludefile
  831.  
  832.  
  833.           Richard Conn                                          Page 6
  834.  
  835.  
  836.                                      PAGER2
  837.  
  838.  
  839.  
  840.           PAGER2> include demo.src demo2.inc
  841.            demo.inc -- 8 Lines
  842.            demo1.txt -- 1 Lines
  843.            demo2.txt -- 1 Lines
  844.  
  845.           PAGER2> x
  846.  
  847.           ifsun0/xanadu> cat demo.src
  848.           --::::::::::
  849.           --demo.inc
  850.           --::::::::::
  851.           -- This is a demonstration of the PAGER2 program
  852.  
  853.           -- The include file is named DEMO.INC
  854.           demo.inc
  855.  
  856.           -- The source files are DEMO1.TXT and DEMO2.TXT
  857.           demo1.txt
  858.           demo2.txt
  859.           --::::::::::
  860.           --demo1.txt
  861.           --::::::::::
  862.           This is file DEMO1.TXT
  863.           --::::::::::
  864.           --demo2.txt
  865.           --::::::::::
  866.           This is file DEMO2.TXT
  867.  
  868.           ifsun0/xanadu> cat demo2.inc
  869.           -- Include file for demo.src
  870.           demo.inc
  871.           demo1.txt
  872.           demo2.txt
  873.  
  874.           ifsun0/xanadu> pager2
  875.           PAGER2, Ada Version 1.1
  876.           Type 'h' for Help
  877.  
  878.           PAGER2> u demo.src
  879.            Extracting demo.inc -- 8 Lines
  880.            Extracting demo1.txt -- 1 Lines
  881.            Extracting demo2.txt -- 1 Lines
  882.  
  883.           PAGER2> unpage
  884.            UNPAGE Command requires the name of a paged file
  885.              Syntax: unpage pagedfilename
  886.  
  887.           PAGER2> u demo.src
  888.            Extracting demo.inc -- 8 Lines
  889.            Extracting demo1.txt -- 1 Lines
  890.            Extracting demo2.txt -- 1 Lines
  891.  
  892.  
  893.           Richard Conn                                          Page 7
  894.  
  895.  
  896.                                      PAGER2
  897.  
  898.  
  899.  
  900.           PAGER2> x
  901.           ifsun0/xanadu> ls -l
  902.           total 5
  903.           -rw-r--r--  1 xanadu        166 Jun 16 10:26 demo.inc
  904.           -rw-r--r--  1 xanadu        325 Jun 16 10:25 demo.src
  905.           -rw-r--r--  1 xanadu         23 Jun 16 10:26 demo1.txt
  906.           -rw-r--r--  1 xanadu         58 Jun 16 10:25 demo2.inc
  907.           -rw-r--r--  1 xanadu         23 Jun 16 10:26 demo2.txt
  908.  
  909.  
  910.  
  911.  
  912.  
  913.  
  914.  
  915.  
  916.  
  917.  
  918.  
  919.  
  920.  
  921.  
  922.  
  923.  
  924.  
  925.  
  926.  
  927.  
  928.  
  929.  
  930.  
  931.  
  932.  
  933.  
  934.  
  935.  
  936.  
  937.  
  938.  
  939.  
  940.  
  941.  
  942.  
  943.  
  944.  
  945.  
  946.  
  947.  
  948.  
  949.  
  950.  
  951.  
  952.  
  953.           Richard Conn                                          Page 8
  954.  
  955. --::::::::::
  956. --cli.ada
  957. --::::::::::
  958. package CLI is
  959. --------------------------------------------------------------------------
  960. --| BEGIN PROLOGUE
  961. --| DESCRIPTION            : CLI is a package which implements a Command
  962. --|                        : Line Interface.  It mirrors the UNIX/C
  963. --|                        : command line interface, providing an argument
  964. --|                        : count and the arguments themselves.
  965. --|                        : 
  966. --| REQUIREMENTS SUPPORTED : Command Line Interface
  967. --|                        : 
  968. --| LIMITATIONS            : Compiler limit on string length and dynamic
  969. --|                        :    memory.
  970. --|                        : INITIALIZE must be called once, and only once,
  971. --|                        :    during the execution of the main Ada proc.
  972. --|                        : 
  973. --| AUTHOR(S)              : Richard Conn (RLC)
  974. --| CHANGE LOG             : 02/25/88  RLC  Initial Version
  975. --|                        : 05/12/89  RLC  Review and upgrade
  976. --| END PROLOGUE
  977. --------------------------------------------------------------------------
  978.    
  979.    procedure INITIALIZE (PROGRAM_NAME        : in STRING;
  980.                          COMMAND_LINE_PROMPT : in STRING);
  981.    -- Initialize this package (this routine must be called before any other
  982.    -- routines or objects are called or referenced); CALL THIS PROCEDURE
  983.    -- ONLY ONE TIME
  984.  
  985.    function ARGC return NATURAL;
  986.    -- Number (1 to N) of command line arguments
  987.    -- ARGC is at least 1 because the name of the program/process
  988.    --   is always ARGV(0)
  989.  
  990.    function ARGV (INDEX : in NATURAL) return STRING;
  991.    -- Return the INDEXth (0 <= INDEX < ARGC) command line argument
  992.    -- Example: if ARGC = 1, ARGV(0) is the only valid argument string
  993.    -- ARGV(0) is always the name of the program/process
  994.  
  995.    INVALID_INDEX    : exception;
  996.    -- raised by ARGV if INDEX >= ARGC
  997.    UNEXPECTED_ERROR : exception;
  998.    
  999. end CLI;
  1000. --::::::::::
  1001. --cli_alsys.ada
  1002. --::::::::::
  1003. -- This implementation of Package Body CLI is Alsys-specific (SUN).
  1004. -- It requires the Alsys package SYSTEM_ENVIRONMENT.
  1005. -- Alsys Ada, Version 3.2
  1006. with TEXT_IO;
  1007. with SYSTEM_ENVIRONMENT;
  1008. package body CLI is
  1009.  
  1010.    LOCAL_ARGC : NATURAL := SYSTEM_ENVIRONMENT.ARG_COUNT;
  1011.    -- Value of ARGC as stored internally
  1012.    
  1013.    procedure INITIALIZE (PROGRAM_NAME        : in STRING;
  1014.                          COMMAND_LINE_PROMPT : in STRING) is
  1015.       
  1016.       --========================= PDL ===========================
  1017.       --|ABSTRACT:
  1018.       --|    INITIALIZE performs necessary initializations.
  1019.       --|DESIGN DESCRIPTION:
  1020.       --|    No initialization needed
  1021.       --=========================================================
  1022.       
  1023.    begin
  1024.       null;
  1025.    end INITIALIZE;
  1026.    
  1027.    function ARGC return NATURAL is
  1028.       
  1029.       --========================= PDL ===========================
  1030.       --|ABSTRACT:
  1031.       --|    ARGC returns the argument count.
  1032.       --|DESIGN DESCRIPTION:
  1033.       --|    Return LOCAL_ARGC
  1034.       --=========================================================
  1035.       
  1036.    begin
  1037.       return LOCAL_ARGC;
  1038.    end ARGC;
  1039.  
  1040.    function ARGV (INDEX : in NATURAL) return STRING is
  1041.       
  1042.       --========================= PDL ===========================
  1043.       --|ABSTRACT:
  1044.       --|    ARGV returns the indicated argument string.
  1045.       --|DESIGN DESCRIPTION:
  1046.       --|    If INDEX is out of range, raise INVALID_INDEX
  1047.       --|    Return GET_FROM_LIST(INDEX)
  1048.       --=========================================================
  1049.       
  1050.    begin
  1051.       if INDEX >= LOCAL_ARGC then
  1052.          raise INVALID_INDEX;
  1053.       end if;
  1054.       return SYSTEM_ENVIRONMENT.ARG_VALUE (INDEX);
  1055.    exception
  1056.       when INVALID_INDEX  =>
  1057.          raise ;
  1058.       when others    =>
  1059.          raise UNEXPECTED_ERROR;
  1060.    end ARGV;
  1061.    
  1062. end CLI;
  1063. --::::::::::
  1064. --cli_cais.ada
  1065. --::::::::::
  1066. -- This implementation of Package Body CLI interfaces thru a CAIS
  1067. -- (CAIS = Common APSE Interface Set, where APSE = Ada Programming
  1068. -- Support Environment).
  1069. -- The definition of CAIS used was DoD-STD-1838, dated 9 October 1986.
  1070. -- Note: THIS IS UNTESTED BUT BELIEVED TO BE CORRECT (no working CAIS
  1071. --       implementation was available to test this against).
  1072. with CAIS_PROCESS_DEFINITIONS;
  1073. with CAIS_PROCESS_MANAGEMENT;
  1074. with CAIS_LIST_MANAGEMENT;
  1075. package body CLI is
  1076.  
  1077.    LOCAL_ARGC : NATURAL := 1;
  1078.    -- Local ARGC value used internally
  1079.  
  1080.    package STRING_LIST is
  1081.       
  1082.       NUMBER_OF_STRINGS : NATURAL := 0;
  1083.       
  1084.       procedure ADD_TO_LIST (ITEM : in STRING);
  1085.       function GET_FROM_LIST (ITEM : in NATURAL) return STRING;
  1086.       
  1087.    end STRING_LIST;
  1088.    
  1089.    package body STRING_LIST is
  1090.       
  1091.       type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL);
  1092.       type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT;
  1093.       type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is 
  1094.          record
  1095.             DS   : STRING (1 .. LENGTH);
  1096.             NEXT : DYNAMIC_STRING;
  1097.          end record;
  1098.       
  1099.       FIRST : DYNAMIC_STRING := null;
  1100.       LAST  : DYNAMIC_STRING := null;
  1101.       
  1102.       procedure ADD_TO_LIST (ITEM : in STRING) is
  1103.          
  1104.          --========================= PDL ===========================
  1105.          --|ABSTRACT:
  1106.          --|    ADD_TO_LIST adds the ITEM string to the linked list
  1107.          --|    of dynamic strings implemented by this package.
  1108.          --|DESIGN DESCRIPTION:
  1109.          --|    Create new DYNAMIC_STRING_OBJECT of the proper length
  1110.          --|    Set DS field of new object to the ITEM string
  1111.          --|    Set the NEXT field of the new object to NULL
  1112.          --|    If FIRST pointer is null
  1113.          --|      Set FIRST and LAST to point to the new object
  1114.          --|    Else
  1115.          --|      Set LAST.NEXT to point to the new object
  1116.          --|      Set LAST to point to the new object
  1117.          --|    End if
  1118.          --|    Increment NUMBER_OF_STRINGS
  1119.          --=========================================================
  1120.          
  1121.          TEMP : DYNAMIC_STRING;
  1122.       begin
  1123.          TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH);
  1124.          TEMP.DS (1 .. ITEM'LENGTH) := ITEM;
  1125.          TEMP.NEXT                  := null;
  1126.          if FIRST = null then
  1127.             FIRST := TEMP;
  1128.             LAST  := TEMP;
  1129.          else
  1130.             LAST.NEXT := TEMP;
  1131.             LAST      := TEMP;
  1132.          end if;
  1133.          NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1;
  1134.       end ADD_TO_LIST;
  1135.       
  1136.       function GET_FROM_LIST (ITEM : in NATURAL) return STRING is
  1137.          
  1138.          --========================= PDL ===========================
  1139.          --|ABSTRACT:
  1140.          --|    GET_FROM_LIST returns the ITEM string from the linked list
  1141.          --|    of dynamic strings implemented by this package.
  1142.          --|DESIGN DESCRIPTION:
  1143.          --|    If ITEM > 0
  1144.          --|        Advance to desired item
  1145.          --|    End If
  1146.          --|    Return the DS field of the desired item
  1147.          --=========================================================
  1148.          
  1149.          ROVER : DYNAMIC_STRING := FIRST;
  1150.       begin
  1151.          if ITEM > 0 then
  1152.             for I in 1 .. ITEM loop
  1153.                ROVER := ROVER.NEXT;
  1154.             end loop;
  1155.          end if;
  1156.          return ROVER.DS;
  1157.       end GET_FROM_LIST;
  1158.       
  1159.    end STRING_LIST;
  1160.    
  1161.    procedure INITIALIZE (PROGRAM_NAME        : in STRING;
  1162.                          COMMAND_LINE_PROMPT : in STRING) is
  1163.       
  1164.       --========================= PDL ===========================
  1165.       --|ABSTRACT:
  1166.       --|    INITIALIZE prompts the user for the command line
  1167.       --|    arguments and loads the linked list with them.
  1168.       --|DESIGN DESCRIPTION:
  1169.       --|    Set the first list object to PROGRAM_NAME
  1170.       --|    Get the list of parameters for the process
  1171.       --|    For each parameter, loop
  1172.       --|        Extract the next parameter (item)
  1173.       --|        Convert the parameter (item) to text
  1174.       --|        Add text to the list
  1175.       --|    End Loop
  1176.       --|    Set LOCAL_ARGC to NUMBER_OF_STRINGS
  1177.       --=========================================================
  1178.       
  1179.       PARAMETERS           : CAIS_PROCESS_DEFINITIONS.PARAMETER_LIST;
  1180.       CURRENT_PARAMETER    : CAIS_PROCESS_DEFINITIONS.PARAMETER_LIST;
  1181.       NUMBER_OF_PARAMETERS : CAIS_LIST_MANAGEMENT.LIST_SIZE;
  1182.  
  1183.    begin
  1184.       STRING_LIST.ADD_TO_LIST(PROGRAM_NAME);
  1185.       CAIS_PROCESS_MANAGEMENT.GET_PARAMETERS (PARAMETERS);
  1186.       NUMBER_OF_PARAMETERS := CAIS_LIST_MANAGEMENT.NUMBER_OF_ITEMS
  1187.             (PARAMETERS);
  1188.       for I in 1 .. NUMBER_OF_PARAMETERS loop
  1189.          CAIS_LIST_MANAGEMENT.CAIS_LIST_ITEM.EXTRACT_VALUE
  1190.                (FROM_LIST     => PARAMETERS,
  1191.                 ITEM_POSITION => I,
  1192.                 VALUE         => CURRENT_PARAMETER);
  1193.          STRING_LIST.ADD_TO_LIST
  1194.                (CAIS_LIST_MANAGEMENT.TEXT_FORM(CURRENT_PARAMETER));
  1195.       end loop;
  1196.       LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS;
  1197.    end INITIALIZE;
  1198.    
  1199.    function ARGC return NATURAL is
  1200.       
  1201.       --========================= PDL ===========================
  1202.       --|ABSTRACT:
  1203.       --|    ARGC returns the argument count.
  1204.       --|DESIGN DESCRIPTION:
  1205.       --|    Return LOCAL_ARGC
  1206.       --=========================================================
  1207.       
  1208.    begin
  1209.       return LOCAL_ARGC;
  1210.    end ARGC;
  1211.  
  1212.    function ARGV (INDEX : in NATURAL) return STRING is
  1213.       
  1214.       --========================= PDL ===========================
  1215.       --|ABSTRACT:
  1216.       --|    ARGV returns the indicated argument string.
  1217.       --|DESIGN DESCRIPTION:
  1218.       --|    If INDEX is out of range, raise INVALID_INDEX
  1219.       --|    Return GET_FROM_LIST(INDEX)
  1220.       --=========================================================
  1221.       
  1222.    begin
  1223.       if INDEX >= ARGC then
  1224.          raise INVALID_INDEX;
  1225.       end if;
  1226.       return STRING_LIST.GET_FROM_LIST (INDEX);
  1227.    exception
  1228.       when INVALID_INDEX  =>
  1229.          raise ;
  1230.       when others    =>
  1231.          raise UNEXPECTED_ERROR;
  1232.    end ARGV;
  1233.    
  1234. end CLI;
  1235. --::::::::::
  1236. --cli_general.ada
  1237. --::::::::::
  1238. -- This implementation of Package Body CLI is general-purpose.
  1239. -- Using TEXT_IO, it prompts the user for input arguments and
  1240. -- accepts these arguments via a GET_LINE call.
  1241. with TEXT_IO;
  1242. package body CLI is
  1243.  
  1244.    LOCAL_ARGC : NATURAL := 0;
  1245.    
  1246.    package STRING_LIST is
  1247.       
  1248.       NUMBER_OF_STRINGS : NATURAL := 0;
  1249.       
  1250.       procedure ADD_TO_LIST (ITEM : in STRING);
  1251.       function GET_FROM_LIST (ITEM : in NATURAL) return STRING;
  1252.       
  1253.    end STRING_LIST;
  1254.    
  1255.    package body STRING_LIST is
  1256.       
  1257.       type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL);
  1258.       type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT;
  1259.       type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is 
  1260.          record
  1261.             DS   : STRING (1 .. LENGTH);
  1262.             NEXT : DYNAMIC_STRING;
  1263.          end record;
  1264.       
  1265.       FIRST : DYNAMIC_STRING := null;
  1266.       LAST  : DYNAMIC_STRING := null;
  1267.       
  1268.       procedure ADD_TO_LIST (ITEM : in STRING) is
  1269.          
  1270.          --========================= PDL ===========================
  1271.          --|ABSTRACT:
  1272.          --|    ADD_TO_LIST adds the ITEM string to the linked list
  1273.          --|    of dynamic strings implemented by this package.
  1274.          --|DESIGN DESCRIPTION:
  1275.          --|    Create new DYNAMIC_STRING_OBJECT of the proper length
  1276.          --|    Set DS field of new object to the ITEM string
  1277.          --|    Set the NEXT field of the new object to NULL
  1278.          --|    If FIRST pointer is null
  1279.          --|      Set FIRST and LAST to point to the new object
  1280.          --|    Else
  1281.          --|      Set LAST.NEXT to point to the new object
  1282.          --|      Set LAST to point to the new object
  1283.          --|    End if
  1284.          --|    Increment NUMBER_OF_STRINGS
  1285.          --=========================================================
  1286.          
  1287.          TEMP : DYNAMIC_STRING;
  1288.       begin
  1289.          TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH);
  1290.          TEMP.DS (1 .. ITEM'LENGTH) := ITEM;
  1291.          TEMP.NEXT                  := null;
  1292.          if FIRST = null then
  1293.             FIRST := TEMP;
  1294.             LAST  := TEMP;
  1295.          else
  1296.             LAST.NEXT := TEMP;
  1297.             LAST      := TEMP;
  1298.          end if;
  1299.          NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1;
  1300.       end ADD_TO_LIST;
  1301.       
  1302.       function GET_FROM_LIST (ITEM : in NATURAL) return STRING is
  1303.          
  1304.          --========================= PDL ===========================
  1305.          --|ABSTRACT:
  1306.          --|    GET_FROM_LIST returns the ITEM string from the linked list
  1307.          --|    of dynamic strings implemented by this package.
  1308.          --|DESIGN DESCRIPTION:
  1309.          --|    If ITEM > 0
  1310.          --|        Advance to desired item
  1311.          --|    End If
  1312.          --|    Return the DS field of the desired item
  1313.          --=========================================================
  1314.          
  1315.          ROVER : DYNAMIC_STRING := FIRST;
  1316.       begin
  1317.          if ITEM > 0 then
  1318.             for I in 1 .. ITEM loop
  1319.                ROVER := ROVER.NEXT;
  1320.             end loop;
  1321.          end if;
  1322.          return ROVER.DS;
  1323.       end GET_FROM_LIST;
  1324.       
  1325.    end STRING_LIST;
  1326.    
  1327.    procedure INITIALIZE (PROGRAM_NAME        : in STRING;
  1328.                          COMMAND_LINE_PROMPT : in STRING) is
  1329.       
  1330.       --========================= PDL ===========================
  1331.       --|ABSTRACT:
  1332.       --|    INITIALIZE prompts the user for the command line
  1333.       --|    arguments and loads the linked list with them.
  1334.       --|DESIGN DESCRIPTION:
  1335.       --|    Set CURRENT_STATE to LOOKING_FOR_TOKEN
  1336.       --|    Set the first list object to PROGRAM_NAME
  1337.       --|    Prompt the user with COMMAND_LINE_PROMPT and
  1338.       --|      get his response
  1339.       --|    Over number of characters in line, loop
  1340.       --|        Case CURRENT_STATE
  1341.       --|            When LOOKING_FOR_TOKEN
  1342.       --|                If character is not white-space
  1343.       --|                    Set CURRENT_STATE to IN_TOKEN
  1344.       --|                    If character is quote (")
  1345.       --|                        Set QUOTED to TRUE
  1346.       --|                        Set START to the character's index + 1
  1347.       --|                    Else
  1348.       --|                        Set QUOTED to FALSE
  1349.       --|                        Set START to the character's index
  1350.       --|                    End IF
  1351.       --|                End If
  1352.       --|            When IN_TOKEN
  1353.       --|                If QUOTED
  1354.       --|                    If character is quote (")
  1355.       --|                        Set STOP to the previous character's index
  1356.       --|                        Add slice from START to STOP to list
  1357.       --|                        Set CURRENT_STATE to LOOKING_FOR_TOKEN
  1358.       --|                    End If
  1359.       --|                ElsIF character is white-space
  1360.       --|                    Set STOP to the previous character's index
  1361.       --|                    Add slice from START to STOP to list
  1362.       --|                    Set CURRENT_STATE to LOOKING_FOR_TOKEN
  1363.       --|                End If
  1364.       --|        End Case
  1365.       --|    End Loop
  1366.       --|    If CURRENT_STATE is IN_TOKEN
  1367.       --|        Set STOP to the previous character's index
  1368.       --|        Add slice from START to STOP to list
  1369.       --|    End if
  1370.       --|    Set LOCAL_ARGC to NUMBER_OF_STRINGS
  1371.       --|    Output NEW_LINE (to reset column count in TEXT_IO)
  1372.       --=========================================================
  1373.       
  1374.       ARGCOUNT      : NATURAL := 1;
  1375.       INLINE        : STRING (1 .. 400);
  1376.       LAST          : NATURAL;
  1377.       START         : NATURAL;
  1378.       STOP          : NATURAL;
  1379.       QUOTED        : BOOLEAN;
  1380.       type STATE is (LOOKING_FOR_TOKEN, IN_TOKEN);
  1381.       CURRENT_STATE : STATE   := LOOKING_FOR_TOKEN;
  1382.    begin
  1383.       STRING_LIST.ADD_TO_LIST (PROGRAM_NAME);
  1384.       TEXT_IO.PUT (COMMAND_LINE_PROMPT);
  1385.       TEXT_IO.GET_LINE (INLINE, LAST);
  1386.       for I in 1 .. LAST loop
  1387.          case CURRENT_STATE is
  1388.             when LOOKING_FOR_TOKEN  =>
  1389.                if INLINE (I) > ' ' then
  1390.                   CURRENT_STATE := IN_TOKEN;
  1391.                   if INLINE (I) = '"' then
  1392.                      QUOTED := TRUE;
  1393.                      START  := I;
  1394.                   else
  1395.                      QUOTED := FALSE;
  1396.                      START  := I;
  1397.                   end if;
  1398.                end if;
  1399.             when IN_TOKEN =>
  1400.                if QUOTED then
  1401.                   if INLINE (I) = '"' then
  1402.                      STOP          := I;
  1403.                      STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
  1404.                      CURRENT_STATE := LOOKING_FOR_TOKEN;
  1405.                   end if;
  1406.                elsif INLINE (I) <= ' ' then
  1407.                   STOP          := I - 1;
  1408.                   STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
  1409.                   CURRENT_STATE := LOOKING_FOR_TOKEN;
  1410.                end if;
  1411.          end case;
  1412.       end loop;
  1413.       if CURRENT_STATE = IN_TOKEN then
  1414.          STOP := LAST;
  1415.          STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
  1416.       end if;
  1417.       LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS;
  1418.       TEXT_IO.NEW_LINE;
  1419.    end INITIALIZE;
  1420.    
  1421.    function ARGC return NATURAL is
  1422.       
  1423.       --========================= PDL ===========================
  1424.       --|ABSTRACT:
  1425.       --|    ARGC returns the argument count.
  1426.       --|DESIGN DESCRIPTION:
  1427.       --|    Return LOCAL_ARGC
  1428.       --=========================================================
  1429.       
  1430.    begin
  1431.       return LOCAL_ARGC;
  1432.    end ARGC;
  1433.  
  1434.    function ARGV (INDEX : in NATURAL) return STRING is
  1435.       
  1436.       --========================= PDL ===========================
  1437.       --|ABSTRACT:
  1438.       --|    ARGV returns the indicated argument string.
  1439.       --|DESIGN DESCRIPTION:
  1440.       --|    If INDEX is out of range, raise INVALID_INDEX
  1441.       --|    Return GET_FROM_LIST(INDEX)
  1442.       --=========================================================
  1443.       
  1444.    begin
  1445.       if INDEX >= LOCAL_ARGC then
  1446.          raise INVALID_INDEX;
  1447.       end if;
  1448.       return STRING_LIST.GET_FROM_LIST (INDEX);
  1449.    exception
  1450.       when INVALID_INDEX  =>
  1451.          raise ;
  1452.       when others    =>
  1453.          raise UNEXPECTED_ERROR;
  1454.    end ARGV;
  1455.    
  1456. end CLI;
  1457. --::::::::::
  1458. --cli_integr.ada
  1459. --::::::::::
  1460. -- This implementation of Package Body CLI is for IntegrAda.
  1461. -- It has been tested under IntegrAda 4.0.1 using MSDOS 3.3.
  1462. with UTIL;
  1463. package body CLI is
  1464.  
  1465.    LOCAL_ARGC : NATURAL := 1;
  1466.    -- Local ARGC value stored internally
  1467.  
  1468.    package STRING_LIST is
  1469.       
  1470.       NUMBER_OF_STRINGS : NATURAL := 0;
  1471.       
  1472.       procedure ADD_TO_LIST (ITEM : in STRING);
  1473.       function GET_FROM_LIST (ITEM : in NATURAL) return STRING;
  1474.       
  1475.    end STRING_LIST;
  1476.    
  1477.    package body STRING_LIST is
  1478.       
  1479.       type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL);
  1480.       type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT;
  1481.       type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is 
  1482.          record
  1483.             DS   : STRING (1 .. LENGTH);
  1484.             NEXT : DYNAMIC_STRING;
  1485.          end record;
  1486.       
  1487.       FIRST : DYNAMIC_STRING := null;
  1488.       LAST  : DYNAMIC_STRING := null;
  1489.       
  1490.       procedure ADD_TO_LIST (ITEM : in STRING) is
  1491.          
  1492.          --========================= PDL ===========================
  1493.          --|ABSTRACT:
  1494.          --|    ADD_TO_LIST adds the ITEM string to the linked list
  1495.          --|    of dynamic strings implemented by this package.
  1496.          --|DESIGN DESCRIPTION:
  1497.          --|    Create new DYNAMIC_STRING_OBJECT of the proper length
  1498.          --|    Set DS field of new object to the ITEM string
  1499.          --|    Set the NEXT field of the new object to NULL
  1500.          --|    If FIRST pointer is null
  1501.          --|      Set FIRST and LAST to point to the new object
  1502.          --|    Else
  1503.          --|      Set LAST.NEXT to point to the new object
  1504.          --|      Set LAST to point to the new object
  1505.          --|    End if
  1506.          --|    Increment NUMBER_OF_STRINGS
  1507.          --=========================================================
  1508.          
  1509.          TEMP : DYNAMIC_STRING;
  1510.       begin
  1511.          TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH);
  1512.          TEMP.DS (1 .. ITEM'LENGTH) := ITEM;
  1513.          TEMP.NEXT                  := null;
  1514.          if FIRST = null then
  1515.             FIRST := TEMP;
  1516.             LAST  := TEMP;
  1517.          else
  1518.             LAST.NEXT := TEMP;
  1519.             LAST      := TEMP;
  1520.          end if;
  1521.          NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1;
  1522.       end ADD_TO_LIST;
  1523.       
  1524.       function GET_FROM_LIST (ITEM : in NATURAL) return STRING is
  1525.          
  1526.          --========================= PDL ===========================
  1527.          --|ABSTRACT:
  1528.          --|    GET_FROM_LIST returns the ITEM string from the linked list
  1529.          --|    of dynamic strings implemented by this package.
  1530.          --|DESIGN DESCRIPTION:
  1531.          --|    If ITEM > 0
  1532.          --|        Advance to desired item
  1533.          --|    End If
  1534.          --|    Return the DS field of the desired item
  1535.          --=========================================================
  1536.          
  1537.          ROVER : DYNAMIC_STRING := FIRST;
  1538.       begin
  1539.          if ITEM > 0 then
  1540.             for I in 1 .. ITEM loop
  1541.                ROVER := ROVER.NEXT;
  1542.             end loop;
  1543.          end if;
  1544.          return ROVER.DS;
  1545.       end GET_FROM_LIST;
  1546.       
  1547.    end STRING_LIST;
  1548.    
  1549.    procedure INITIALIZE (PROGRAM_NAME        : in STRING;
  1550.                          COMMAND_LINE_PROMPT : in STRING) is
  1551.       
  1552.       --========================= PDL ===========================
  1553.       --|ABSTRACT:
  1554.       --|    INITIALIZE prompts the user for the command line
  1555.       --|    arguments and loads the linked list with them.
  1556.       --|DESIGN DESCRIPTION:
  1557.       --|    Set CURRENT_STATE to LOOKING_FOR_TOKEN
  1558.       --|    Set PROGRAM_NAME as first token
  1559.       --|    Obtain the command line string from VAX/VMS
  1560.       --|    Over number of characters in line, loop
  1561.       --|        Case CURRENT_STATE
  1562.       --|            When LOOKING_FOR_TOKEN
  1563.       --|                If character is not white-space
  1564.       --|                    Set CURRENT_STATE to IN_TOKEN
  1565.       --|                    If character is quote (")
  1566.       --|                        Set QUOTED to TRUE
  1567.       --|                        Set START to the character's index + 1
  1568.       --|                    Else
  1569.       --|                        Set QUOTED to FALSE
  1570.       --|                        Set START to the character's index
  1571.       --|                    End IF
  1572.       --|                End If
  1573.       --|            When IN_TOKEN
  1574.       --|                If QUOTED
  1575.       --|                    If character is quote (")
  1576.       --|                        Set STOP to the previous character's index
  1577.       --|                        Add slice from START to STOP to list
  1578.       --|                        Set CURRENT_STATE to LOOKING_FOR_TOKEN
  1579.       --|                    End If
  1580.       --|                ElsIF character is white-space
  1581.       --|                    Set STOP to the previous character's index
  1582.       --|                    Add slice from START to STOP to list
  1583.       --|                    Set CURRENT_STATE to LOOKING_FOR_TOKEN
  1584.       --|                End If
  1585.       --|        End Case
  1586.       --|    End Loop
  1587.       --|    If CURRENT_STATE is IN_TOKEN
  1588.       --|        Set STOP to the previous character's index
  1589.       --|        Add slice from START to STOP to list
  1590.       --|    End if
  1591.       --|    Set LOCAL_ARGC to NUMBER_OF_STRINGS
  1592.       --=========================================================
  1593.       
  1594.       ARGCOUNT      : NATURAL := 1;
  1595.       INLINE        : UTIL.COMMAND_STRING; -- for IntegrAda
  1596.       INLEN         : NATURAL;             -- for IntegrAda
  1597.       START         : NATURAL;
  1598.       STOP          : NATURAL;
  1599.       QUOTED        : BOOLEAN;
  1600.  
  1601.       type STATE is (LOOKING_FOR_TOKEN, IN_TOKEN);
  1602.       CURRENT_STATE : STATE   := LOOKING_FOR_TOKEN;
  1603.  
  1604.    begin
  1605.       STRING_LIST.ADD_TO_LIST (PROGRAM_NAME);
  1606.       UTIL.COMMAND_LINE (INLINE, INLEN); -- INLINE is command line
  1607.       for I in 1 .. INLEN loop
  1608.          case CURRENT_STATE is
  1609.             when LOOKING_FOR_TOKEN  =>
  1610.                if INLINE (I) > ' ' then
  1611.                   CURRENT_STATE := IN_TOKEN;
  1612.                   if INLINE (I) = '"' then
  1613.                      QUOTED := TRUE;
  1614.                      START  := I;
  1615.                   else
  1616.                      QUOTED := FALSE;
  1617.                      START  := I;
  1618.                   end if;
  1619.                end if;
  1620.             when IN_TOKEN =>
  1621.                if QUOTED then
  1622.                   if INLINE (I) = '"' then
  1623.                      STOP          := I;
  1624.                      STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
  1625.                      CURRENT_STATE := LOOKING_FOR_TOKEN;
  1626.                   end if;
  1627.                elsif INLINE (I) <= ' ' then
  1628.                   STOP          := I - 1;
  1629.                   STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
  1630.                   CURRENT_STATE := LOOKING_FOR_TOKEN;
  1631.                end if;
  1632.          end case;
  1633.       end loop;
  1634.       if CURRENT_STATE = IN_TOKEN then
  1635.          STOP := INLEN;
  1636.          STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
  1637.       end if;
  1638.       LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS;
  1639.    end INITIALIZE;
  1640.    
  1641.    function ARGC return NATURAL is
  1642.       
  1643.       --========================= PDL ===========================
  1644.       --|ABSTRACT:
  1645.       --|    ARGC returns the argument count.
  1646.       --|DESIGN DESCRIPTION:
  1647.       --|    Return LOCAL_ARGC
  1648.       --=========================================================
  1649.       
  1650.    begin
  1651.       return LOCAL_ARGC;
  1652.    end ARGC;
  1653.  
  1654.    function ARGV (INDEX : in NATURAL) return STRING is
  1655.       
  1656.       --========================= PDL ===========================
  1657.       --|ABSTRACT:
  1658.       --|    ARGV returns the indicated argument string.
  1659.       --|DESIGN DESCRIPTION:
  1660.       --|    If INDEX is out of range, raise INVALID_INDEX
  1661.       --|    Return GET_FROM_LIST(INDEX)
  1662.       --=========================================================
  1663.       
  1664.    begin
  1665.       if INDEX >= LOCAL_ARGC then
  1666.          raise INVALID_INDEX;
  1667.       end if;
  1668.       return STRING_LIST.GET_FROM_LIST (INDEX);
  1669.    exception
  1670.       when INVALID_INDEX  =>
  1671.          raise ;
  1672.       when others    =>
  1673.          raise UNEXPECTED_ERROR;
  1674.    end ARGV;
  1675.    
  1676. end CLI;
  1677. --::::::::::
  1678. --cli_verdix.ada
  1679. --::::::::::
  1680. -- This implementation of Package Body CLI is Verdix-specific (SUN).
  1681. -- The following Verdix Ada packages must be compiled into
  1682. -- the Ada library or an Ada program unit library containing these
  1683. -- packages must be placed in the library search path before this
  1684. -- package body is compiled:
  1685. --      standard/a_strings.a
  1686. --      standard/a_strings_b.a
  1687. --      standard/c_strings.a
  1688. --      standard/c_strings_b.a
  1689. --      verdixlib/cmd_line_s.a
  1690. --      verdixlib/cmd_line_b.a
  1691. -- Verdix Ada Development System, Version 5.41 and 5.5
  1692. with COMMAND_LINE;
  1693. with A_STRINGS;
  1694. package body CLI is
  1695.  
  1696.    LOCAL_ARGC : NATURAL := NATURAL (COMMAND_LINE.ARGC);
  1697.    -- Local value of ARGC stored internally
  1698.  
  1699.    procedure INITIALIZE (PROGRAM_NAME        : in STRING;
  1700.                          COMMAND_LINE_PROMPT : in STRING) is
  1701.       
  1702.       --========================= PDL ===========================
  1703.       --|ABSTRACT:
  1704.       --|    INITIALIZE prompts the user for the command line
  1705.       --|    arguments and loads the linked list with them.
  1706.       --|DESIGN DESCRIPTION:
  1707.       --|    Do nothing (no initialization required)
  1708.       --=========================================================
  1709.       
  1710.    begin
  1711.       null;
  1712.    end INITIALIZE;
  1713.    
  1714.    function ARGC return NATURAL is
  1715.       
  1716.       --========================= PDL ===========================
  1717.       --|ABSTRACT:
  1718.       --|    ARGC returns the argument count.
  1719.       --|DESIGN DESCRIPTION:
  1720.       --|    Return LOCAL_ARGC
  1721.       --=========================================================
  1722.       
  1723.    begin
  1724.       return LOCAL_ARGC;
  1725.    end ARGC;
  1726.  
  1727.    function ARGV (INDEX : in NATURAL) return STRING is
  1728.       
  1729.       --========================= PDL ===========================
  1730.       --|ABSTRACT:
  1731.       --|    ARGV returns the indicated argument string.
  1732.       --|DESIGN DESCRIPTION:
  1733.       --|    If INDEX is out of range, raise INVALID_INDEX
  1734.       --|    Return COMMAND_LINE.ARGV.all (INTEGER (INDEX)).all.S
  1735.       --=========================================================
  1736.       
  1737.    begin
  1738.       if INDEX >= LOCAL_ARGC then
  1739.          raise INVALID_INDEX;
  1740.       end if;
  1741.       return COMMAND_LINE.ARGV.all (INTEGER (INDEX)).all.S;
  1742.    exception
  1743.       when INVALID_INDEX  =>
  1744.          raise ;
  1745.       when others    =>
  1746.          raise UNEXPECTED_ERROR;
  1747.    end ARGV;
  1748.    
  1749. end CLI;
  1750. --::::::::::
  1751. --cli_vms.ada
  1752. --::::::::::
  1753. -- This implementation of Package Body CLI is for DEC Ada using VAX/VMS.
  1754. -- It has been tested under VAX/VMS 4.5 using DEC Ada Version 1.3-24.
  1755. -- Note: any executable produced which uses this package must be able to
  1756. -- read the command line parameters.  To do this, after producing the EXE
  1757. -- file via ACS LINK, you have to define a symbol like:
  1758. --    $ symbol:==$disk:[dir]exe-file-name
  1759. -- and then run the program by using the symbol:
  1760. --    $ symbol this is a test
  1761. package body CLI is
  1762.  
  1763.    LOCAL_ARGC : NATURAL := 1;
  1764.    -- Local ARGC value stored internally
  1765.  
  1766.    package STRING_LIST is
  1767.       
  1768.       NUMBER_OF_STRINGS : NATURAL := 0;
  1769.       
  1770.       procedure ADD_TO_LIST (ITEM : in STRING);
  1771.       function GET_FROM_LIST (ITEM : in NATURAL) return STRING;
  1772.       
  1773.    end STRING_LIST;
  1774.    
  1775.    package body STRING_LIST is
  1776.       
  1777.       type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL);
  1778.       type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT;
  1779.       type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is 
  1780.          record
  1781.             DS   : STRING (1 .. LENGTH);
  1782.             NEXT : DYNAMIC_STRING;
  1783.          end record;
  1784.       
  1785.       FIRST : DYNAMIC_STRING := null;
  1786.       LAST  : DYNAMIC_STRING := null;
  1787.       
  1788.       procedure ADD_TO_LIST (ITEM : in STRING) is
  1789.          
  1790.          --========================= PDL ===========================
  1791.          --|ABSTRACT:
  1792.          --|    ADD_TO_LIST adds the ITEM string to the linked list
  1793.          --|    of dynamic strings implemented by this package.
  1794.          --|DESIGN DESCRIPTION:
  1795.          --|    Create new DYNAMIC_STRING_OBJECT of the proper length
  1796.          --|    Set DS field of new object to the ITEM string
  1797.          --|    Set the NEXT field of the new object to NULL
  1798.          --|    If FIRST pointer is null
  1799.          --|      Set FIRST and LAST to point to the new object
  1800.          --|    Else
  1801.          --|      Set LAST.NEXT to point to the new object
  1802.          --|      Set LAST to point to the new object
  1803.          --|    End if
  1804.          --|    Increment NUMBER_OF_STRINGS
  1805.          --=========================================================
  1806.          
  1807.          TEMP : DYNAMIC_STRING;
  1808.       begin
  1809.          TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH);
  1810.          TEMP.DS (1 .. ITEM'LENGTH) := ITEM;
  1811.          TEMP.NEXT                  := null;
  1812.          if FIRST = null then
  1813.             FIRST := TEMP;
  1814.             LAST  := TEMP;
  1815.          else
  1816.             LAST.NEXT := TEMP;
  1817.             LAST      := TEMP;
  1818.          end if;
  1819.          NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1;
  1820.       end ADD_TO_LIST;
  1821.       
  1822.       function GET_FROM_LIST (ITEM : in NATURAL) return STRING is
  1823.          
  1824.          --========================= PDL ===========================
  1825.          --|ABSTRACT:
  1826.          --|    GET_FROM_LIST returns the ITEM string from the linked list
  1827.          --|    of dynamic strings implemented by this package.
  1828.          --|DESIGN DESCRIPTION:
  1829.          --|    If ITEM > 0
  1830.          --|        Advance to desired item
  1831.          --|    End If
  1832.          --|    Return the DS field of the desired item
  1833.          --=========================================================
  1834.          
  1835.          ROVER : DYNAMIC_STRING := FIRST;
  1836.       begin
  1837.          if ITEM > 0 then
  1838.             for I in 1 .. ITEM loop
  1839.                ROVER := ROVER.NEXT;
  1840.             end loop;
  1841.          end if;
  1842.          return ROVER.DS;
  1843.       end GET_FROM_LIST;
  1844.       
  1845.    end STRING_LIST;
  1846.    
  1847.    procedure INITIALIZE (PROGRAM_NAME        : in STRING;
  1848.                          COMMAND_LINE_PROMPT : in STRING) is
  1849.       
  1850.       --========================= PDL ===========================
  1851.       --|ABSTRACT:
  1852.       --|    INITIALIZE prompts the user for the command line
  1853.       --|    arguments and loads the linked list with them.
  1854.       --|DESIGN DESCRIPTION:
  1855.       --|    Set CURRENT_STATE to LOOKING_FOR_TOKEN
  1856.       --|    Set PROGRAM_NAME as first token
  1857.       --|    Obtain the command line string from VAX/VMS
  1858.       --|    Over number of characters in line, loop
  1859.       --|        Case CURRENT_STATE
  1860.       --|            When LOOKING_FOR_TOKEN
  1861.       --|                If character is not white-space
  1862.       --|                    Set CURRENT_STATE to IN_TOKEN
  1863.       --|                    If character is quote (")
  1864.       --|                        Set QUOTED to TRUE
  1865.       --|                        Set START to the character's index + 1
  1866.       --|                    Else
  1867.       --|                        Set QUOTED to FALSE
  1868.       --|                        Set START to the character's index
  1869.       --|                    End IF
  1870.       --|                End If
  1871.       --|            When IN_TOKEN
  1872.       --|                If QUOTED
  1873.       --|                    If character is quote (")
  1874.       --|                        Set STOP to the previous character's index
  1875.       --|                        Add slice from START to STOP to list
  1876.       --|                        Set CURRENT_STATE to LOOKING_FOR_TOKEN
  1877.       --|                    End If
  1878.       --|                ElsIF character is white-space
  1879.       --|                    Set STOP to the previous character's index
  1880.       --|                    Add slice from START to STOP to list
  1881.       --|                    Set CURRENT_STATE to LOOKING_FOR_TOKEN
  1882.       --|                End If
  1883.       --|        End Case
  1884.       --|    End Loop
  1885.       --|    If CURRENT_STATE is IN_TOKEN
  1886.       --|        Set STOP to the previous character's index
  1887.       --|        Add slice from START to STOP to list
  1888.       --|    End if
  1889.       --|    Set LOCAL_ARGC to NUMBER_OF_STRINGS
  1890.       --=========================================================
  1891.       
  1892.       ARGCOUNT      : NATURAL := 1;
  1893.       INLINE        : STRING (1 .. 132); -- for VAX/VMS
  1894.       START         : NATURAL;
  1895.       STOP          : NATURAL;
  1896.       QUOTED        : BOOLEAN;
  1897.  
  1898.       type STATE is (LOOKING_FOR_TOKEN, IN_TOKEN);
  1899.       CURRENT_STATE : STATE   := LOOKING_FOR_TOKEN;
  1900.  
  1901.       -- Get command line from VAX/VMS
  1902.       procedure GET_FOREIGN (LINE : out STRING);
  1903.       pragma INTERFACE (EXTERNAL, GET_FOREIGN);
  1904.       pragma IMPORT_VALUED_PROCEDURE (GET_FOREIGN,
  1905.                                       "LIB$GET_FOREIGN",
  1906.                                       (STRING),
  1907.                                       (DESCRIPTOR(S)));
  1908.  
  1909.    begin
  1910.       STRING_LIST.ADD_TO_LIST (PROGRAM_NAME);
  1911.       GET_FOREIGN (INLINE); -- INLINE is command line from VAX/VMS
  1912.       for I in INLINE'RANGE loop
  1913.          case CURRENT_STATE is
  1914.             when LOOKING_FOR_TOKEN  =>
  1915.                if INLINE (I) > ' ' then
  1916.                   CURRENT_STATE := IN_TOKEN;
  1917.                   if INLINE (I) = '"' then
  1918.                      QUOTED := TRUE;
  1919.                      START  := I;
  1920.                   else
  1921.                      QUOTED := FALSE;
  1922.                      START  := I;
  1923.                   end if;
  1924.                end if;
  1925.             when IN_TOKEN =>
  1926.                if QUOTED then
  1927.                   if INLINE (I) = '"' then
  1928.                      STOP          := I;
  1929.                      STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
  1930.                      CURRENT_STATE := LOOKING_FOR_TOKEN;
  1931.                   end if;
  1932.                elsif INLINE (I) <= ' ' then
  1933.                   STOP          := I - 1;
  1934.                   STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
  1935.                   CURRENT_STATE := LOOKING_FOR_TOKEN;
  1936.                end if;
  1937.          end case;
  1938.       end loop;
  1939.       if CURRENT_STATE = IN_TOKEN then
  1940.          STOP := INLINE'LAST;
  1941.          STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
  1942.       end if;
  1943.       LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS;
  1944.    end INITIALIZE;
  1945.    
  1946.    function ARGC return NATURAL is
  1947.       
  1948.       --========================= PDL ===========================
  1949.       --|ABSTRACT:
  1950.       --|    ARGC returns the argument count.
  1951.       --|DESIGN DESCRIPTION:
  1952.       --|    Return LOCAL_ARGC
  1953.       --=========================================================
  1954.       
  1955.    begin
  1956.       return LOCAL_ARGC;
  1957.    end ARGC;
  1958.  
  1959.    function ARGV (INDEX : in NATURAL) return STRING is
  1960.       
  1961.       --========================= PDL ===========================
  1962.       --|ABSTRACT:
  1963.       --|    ARGV returns the indicated argument string.
  1964.       --|DESIGN DESCRIPTION:
  1965.       --|    If INDEX is out of range, raise INVALID_INDEX
  1966.       --|    Return GET_FROM_LIST(INDEX)
  1967.       --=========================================================
  1968.       
  1969.    begin
  1970.       if INDEX >= LOCAL_ARGC then
  1971.          raise INVALID_INDEX;
  1972.       end if;
  1973.       return STRING_LIST.GET_FROM_LIST (INDEX);
  1974.    exception
  1975.       when INVALID_INDEX  =>
  1976.          raise ;
  1977.       when others    =>
  1978.          raise UNEXPECTED_ERROR;
  1979.    end ARGV;
  1980.    
  1981. end CLI;
  1982. --::::::::::
  1983. --pager2.ada
  1984. --::::::::::
  1985. -- PROGRAM/CODE BODY NAME:    PAGER2
  1986. -- AUTHOR:            Richard Conn
  1987. -- VERSION:            1.1
  1988. -- DATE:            6/12/89
  1989. -- REVISION HISTORY -
  1990. -- Version    Date    Author        Comments
  1991. --    1.0    8/28/87    Richard Conn    Initial
  1992. --    1.1       6/12/89 Richard Conn    CLI interface added
  1993. -- KEYWORDS -
  1994. --    pager, pager2, paged files, page, unpage
  1995. -- CALLING SYNTAX -
  1996. --    From the command line: pager2
  1997. --    From the command line: pager2 verb arguments
  1998. -- EXTERNAL ROUTINES -
  1999. --    Package CLI
  2000. --    Package TEXT_IO
  2001. -- DESCRIPTION -
  2002. --    PAGER2 assembles, extracts elements from, and lists paged files.
  2003. -- Paged files are text files which contain one or more component files
  2004. -- prefixed by a banner like:
  2005. --
  2006. --    ::::::::::
  2007. --    filename
  2008. --    ::::::::::
  2009. --
  2010. -- or
  2011. --
  2012. --    --::::::::::
  2013. --    --filename
  2014. --    --::::::::::
  2015. --
  2016. --    PAGER2 will manipulate paged files whose components
  2017. -- are prefixed with either banner, but it assembles paged files with only
  2018. -- the second banner (beginning with the Ada comment characters).
  2019.  
  2020. --===========================================================================
  2021. -------------------------- PACKAGE LINE_DEFINITION --------------------------
  2022. --===========================================================================
  2023.  
  2024. -- The following package defines an object of type LINE
  2025. package LINE_DEFINITION is
  2026.  
  2027.     -- The maximum length of a line
  2028.     MAX_LINE_LENGTH : constant NATURAL := 200;
  2029.  
  2030.     -- Type definition for LINE
  2031.     type LINE is record
  2032.     CONTENT : STRING(1 .. MAX_LINE_LENGTH);
  2033.     LAST    : NATURAL;
  2034.     end record;
  2035.     type LINE_LIST_ELEMENT;
  2036.     type LINE_LIST        is access LINE_LIST_ELEMENT;
  2037.     type LINE_LIST_ELEMENT is record
  2038.     CONTENT : LINE;
  2039.     NEXT    : LINE_LIST;
  2040.     end record;
  2041.  
  2042.     -- Banners
  2043.     COMMENT_BANNER  : constant STRING  := "--::::::::::";
  2044.     BANNER          : constant STRING  := "::::::::::";
  2045.  
  2046.     -- Convert strings to LINEs and back
  2047.     function CONVERT(FROM : in STRING) return LINE;
  2048.     function CONVERT(FROM : in LINE) return STRING;
  2049.  
  2050.     -- Convert a LINE to lower-case characters
  2051.     procedure TOLOWER(ITEM : in out LINE);
  2052.     function TOLOWER(ITEM : in LINE) return LINE;
  2053.  
  2054. end LINE_DEFINITION;
  2055.  
  2056. package body LINE_DEFINITION is
  2057.  
  2058.     -- Convert strings to LINEs
  2059.     function CONVERT(FROM : in STRING) return LINE is
  2060.     TO : LINE_DEFINITION.LINE;
  2061.     begin
  2062.     TO.CONTENT(TO.CONTENT'FIRST .. TO.CONTENT'FIRST + FROM'LENGTH - 1) :=
  2063.       FROM;
  2064.     TO.LAST := FROM'LENGTH;
  2065.     return TO;
  2066.     end CONVERT;
  2067.  
  2068.     function CONVERT(FROM : in LINE) return STRING is
  2069.     begin
  2070.     return FROM.CONTENT(FROM.CONTENT'FIRST .. FROM.LAST);
  2071.     end CONVERT;
  2072.  
  2073.     procedure TOLOWER(ITEM : in out LINE) is
  2074.     begin
  2075.     for I in ITEM.CONTENT'FIRST .. ITEM.LAST loop
  2076.         if ITEM.CONTENT(I) in 'A' .. 'Z' then
  2077.         ITEM.CONTENT(I) :=
  2078.                   CHARACTER'VAL(CHARACTER'POS(ITEM.CONTENT(I)) -
  2079.           CHARACTER'POS('A') + CHARACTER'POS('a'));
  2080.         end if;
  2081.     end loop;
  2082.     end TOLOWER;
  2083.  
  2084.     function TOLOWER(ITEM : in LINE) return LINE is
  2085.         MYLINE : LINE;
  2086.     begin
  2087.         MYLINE := ITEM;
  2088.         TOLOWER(MYLINE);
  2089.         return MYLINE;
  2090.     end TOLOWER;
  2091.  
  2092. end LINE_DEFINITION;
  2093.  
  2094. --===========================================================================
  2095. -------------------------- PACKAGE INPUT_FILE -------------------------------
  2096. --===========================================================================
  2097.  
  2098. -- The following package manipulates an object called an INPUT_FILE,
  2099. -- which is a text file that is composed of objects of type LINE.
  2100. -- LINEs can only be read from an INPUT_FILE.
  2101. with LINE_DEFINITION;
  2102. package INPUT_FILE is
  2103.  
  2104.     -- Open the input file
  2105.     -- Exceptions which may be raised: FILE_NOT_FOUND, FILE_ALREADY_OPEN
  2106.     procedure OPEN(FILE_NAME : in STRING);
  2107.     procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE);
  2108.  
  2109.     -- Close the input file
  2110.     -- Exceptions which may be raised: FILE_NOT_OPEN
  2111.     procedure CLOSE;
  2112.  
  2113.     -- Read a line from the input file
  2114.     -- Exceptions which may be raised: FILE_NOT_OPEN, READ_PAST_END_OF_FILE
  2115.     procedure READ(TO : out LINE_DEFINITION.LINE);
  2116.  
  2117.     -- Return TRUE if the input file is empty (no more lines remain)
  2118.     -- Exceptions which may be raised: FILE_NOT_OPEN
  2119.     function END_OF_FILE return BOOLEAN;
  2120.  
  2121.     -- Exceptional conditions
  2122.     FILE_NOT_FOUND        : exception;
  2123.     FILE_ALREADY_OPEN     : exception;
  2124.     FILE_NOT_OPEN         : exception;
  2125.     READ_PAST_END_OF_FILE : exception;
  2126.  
  2127. end INPUT_FILE;
  2128.  
  2129. with TEXT_IO;
  2130. package body INPUT_FILE is
  2131.  
  2132.     -- The file descriptor for the input file
  2133.     FD : TEXT_IO.FILE_TYPE;
  2134.  
  2135.     -- Open the input file
  2136.     procedure OPEN(FILE_NAME : in STRING) is
  2137.     begin
  2138.     TEXT_IO.OPEN(FD, TEXT_IO.IN_FILE, FILE_NAME);
  2139.     exception
  2140.     when TEXT_IO.NAME_ERROR =>
  2141.         raise FILE_NOT_FOUND;
  2142.     when TEXT_IO.STATUS_ERROR =>
  2143.         raise FILE_ALREADY_OPEN;
  2144.     end OPEN;
  2145.  
  2146.     procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE) is
  2147.     begin
  2148.     OPEN(LINE_DEFINITION.CONVERT(FILE_NAME));
  2149.     end OPEN;
  2150.  
  2151.     -- Close the input file
  2152.     procedure CLOSE is
  2153.     begin
  2154.     TEXT_IO.CLOSE(FD);
  2155.     exception
  2156.     when TEXT_IO.STATUS_ERROR =>
  2157.         raise FILE_NOT_OPEN;
  2158.     end CLOSE;
  2159.  
  2160.     -- Read a line from the input file
  2161.     procedure READ(TO : out LINE_DEFINITION.LINE) is
  2162.     begin
  2163.     TEXT_IO.GET_LINE(FD, TO.CONTENT, TO.LAST);
  2164.     exception
  2165.     when TEXT_IO.END_ERROR =>
  2166.         raise READ_PAST_END_OF_FILE;
  2167.     when TEXT_IO.STATUS_ERROR =>
  2168.         raise FILE_NOT_OPEN;
  2169.     end READ;
  2170.  
  2171.     -- Return TRUE if the input file is empty (no more lines remain)
  2172.     function END_OF_FILE return BOOLEAN is
  2173.     begin
  2174.     return TEXT_IO.END_OF_FILE(FD);
  2175.     exception
  2176.     when TEXT_IO.STATUS_ERROR =>
  2177.         raise FILE_NOT_OPEN;
  2178.     end END_OF_FILE;
  2179.  
  2180. end INPUT_FILE;
  2181.  
  2182. --===========================================================================
  2183. -------------------------- PACKAGE OUTPUT_FILE ------------------------------
  2184. --===========================================================================
  2185.  
  2186. -- The following package manipulates an object called an OUTPUT_FILE,
  2187. -- which is a text file that is composed of objects of type LINE.
  2188. -- LINEs can only be written to an OUTPUT_FILE.
  2189. with LINE_DEFINITION;
  2190. package OUTPUT_FILE is
  2191.  
  2192.     -- Open the output file
  2193.     -- Exceptions which may be raised: CANNOT_CREATE_FILE, FILE_ALREADY_OPEN
  2194.     procedure OPEN(FILE_NAME : in STRING);
  2195.     procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE);
  2196.  
  2197.     -- Close the output file
  2198.     -- Exceptions which may be raised: FILE_NOT_OPEN
  2199.     procedure CLOSE;
  2200.  
  2201.     -- Write a line to the output file
  2202.     -- Exceptions which may be raised: FILE_NOT_OPEN, DISK_FULL
  2203.     procedure WRITE(FROM : in LINE_DEFINITION.LINE);
  2204.     procedure WRITE(FROM : in STRING);
  2205.  
  2206.     -- Exceptional conditions
  2207.     CANNOT_CREATE_FILE : exception;
  2208.     FILE_ALREADY_OPEN  : exception;
  2209.     FILE_NOT_OPEN      : exception;
  2210.     DISK_FULL          : exception;
  2211.  
  2212. end OUTPUT_FILE;
  2213.  
  2214. with TEXT_IO;
  2215. package body OUTPUT_FILE is
  2216.  
  2217.     -- File descriptor for the output file
  2218.     FD : TEXT_IO.FILE_TYPE;
  2219.  
  2220.     -- Open the output file
  2221.     procedure OPEN(FILE_NAME : in STRING) is
  2222.     INLINE : STRING(1 .. 80);
  2223.     LAST   : NATURAL;
  2224.     begin
  2225.     TEXT_IO.CREATE(FD, TEXT_IO.OUT_FILE, FILE_NAME);
  2226.     exception
  2227.     when TEXT_IO.STATUS_ERROR =>
  2228.         raise FILE_ALREADY_OPEN;
  2229.     when TEXT_IO.USE_ERROR =>
  2230.         raise CANNOT_CREATE_FILE;
  2231.     when TEXT_IO.NAME_ERROR =>
  2232.         TEXT_IO.PUT_LINE(" Cannot create " & FILE_NAME);
  2233.         loop
  2234.         begin
  2235.             TEXT_IO.PUT(" Enter New File Name: ");
  2236.             TEXT_IO.GET_LINE(INLINE, LAST);
  2237.             TEXT_IO.CREATE(FD, TEXT_IO.OUT_FILE,
  2238.               INLINE(INLINE'FIRST .. LAST));
  2239.             exit;
  2240.         exception
  2241.             when TEXT_IO.NAME_ERROR =>
  2242.             TEXT_IO.PUT_LINE(" Cannot create " &
  2243.               INLINE(INLINE'FIRST .. LAST));
  2244.             when others =>
  2245.             raise ;
  2246.         end;
  2247.         end loop;
  2248.     end OPEN;
  2249.  
  2250.     procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE) is
  2251.     begin
  2252.     OPEN(LINE_DEFINITION.CONVERT(FILE_NAME));
  2253.     end OPEN;
  2254.  
  2255.     -- Close the output file
  2256.     procedure CLOSE is
  2257.     begin
  2258.     TEXT_IO.CLOSE(FD);
  2259.     exception
  2260.     when TEXT_IO.STATUS_ERROR =>
  2261.         raise FILE_NOT_OPEN;
  2262.     end CLOSE;
  2263.  
  2264.     -- Write a line to the output file
  2265.     procedure WRITE(FROM : in LINE_DEFINITION.LINE) is
  2266.     begin
  2267.     TEXT_IO.PUT_LINE(FD, LINE_DEFINITION.CONVERT(FROM));
  2268.     exception
  2269.     when TEXT_IO.STATUS_ERROR =>
  2270.         raise FILE_NOT_OPEN;
  2271.     when others =>
  2272.         raise DISK_FULL;
  2273.     end WRITE;
  2274.  
  2275.     procedure WRITE(FROM : in STRING) is
  2276.     begin
  2277.     WRITE(LINE_DEFINITION.CONVERT(FROM));
  2278.     end WRITE;
  2279.  
  2280. end OUTPUT_FILE;
  2281.  
  2282. --===========================================================================
  2283. -------------------------- PACKAGE INCLUDE_FILE -----------------------------
  2284. --===========================================================================
  2285.  
  2286. -- The following package manipulates an object called an INCLUDE_FILE,
  2287. -- which is a text file that is composed of objects of type LINE.
  2288. -- LINEs can only be read from an INCLUDE_FILE.  An INCLUDE_FILE contains
  2289. -- the following types of LINE objects:
  2290. --    blank lines
  2291. --    comment lines ('-' is the first character in the line)
  2292. --    file names (a string of non-blank characters which does not
  2293. --        begin with the character '-' or '@')
  2294. --    include file names (a string of non-blank characters which
  2295. --        begins with the character '@', where the '@' is used to
  2296. --        prefix the file name within the include file and is not
  2297. --        a part of the file name of the actual disk file)
  2298. -- Include files may be nested several levels (defined by the constant
  2299. -- NESTING_DEPTH).
  2300. with LINE_DEFINITION;
  2301. package INCLUDE_FILE is
  2302.  
  2303.     -- Maximum number of levels include files may be nested
  2304.     NESTING_DEPTH     : constant NATURAL   := 40;
  2305.  
  2306.     -- Character which begins an include file name
  2307.     INCLUDE_CHARACTER : constant CHARACTER := '@';
  2308.  
  2309.     -- Character which begins a comment line
  2310.     COMMENT_CHARACTER : constant CHARACTER := '-';
  2311.  
  2312.     -- Open the include file (the LINE input string contains the leading '@')
  2313.     -- Exceptions which may be raised: FILE_NOT_FOUND, NESTING_LEVEL_EXCEEDED
  2314.     procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE);
  2315.     procedure OPEN(FILE_NAME : in STRING);
  2316.  
  2317.     -- Read a LINE containing a file name from the include file
  2318.     -- Exceptions which may be raised: FILE_NOT_OPEN, READ_PAST_END_OF_FILE
  2319.     procedure READ(TO : out LINE_DEFINITION.LINE);
  2320.  
  2321.     -- Abort processing the include file (close all open files)
  2322.     -- Exceptions which may be raised: FILE_NOT_OPEN
  2323.     procedure STOP;
  2324.  
  2325.     -- Exceptional conditions
  2326.     FILE_NOT_FOUND         : exception;
  2327.     NESTING_LEVEL_EXCEEDED : exception;
  2328.     FILE_NOT_OPEN          : exception;
  2329.     READ_PAST_END_OF_FILE  : exception;
  2330.     INCLUDE_FILE_EMPTY     : exception;
  2331.  
  2332. end INCLUDE_FILE;
  2333.  
  2334. with TEXT_IO;
  2335. package body INCLUDE_FILE is
  2336.  
  2337.     -- File Descriptor for main include file
  2338.     FD              : array(1 .. NESTING_DEPTH) of TEXT_IO.FILE_TYPE;
  2339.     CURRENT_LEVEL   : NATURAL := 0;
  2340.     NEXT_LINE       : LINE_DEFINITION.LINE;    -- next line to return by READ
  2341.     NEXT_LINE_READY : BOOLEAN := FALSE;        -- indicates next line is
  2342.                                                -- available
  2343.  
  2344.     -- Open the include file (the LINE input string contains the leading '@')
  2345.     -- Exceptions which may be raised: FILE_NOT_FOUND, NESTING_LEVEL_EXCEEDED
  2346.     procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE) is
  2347.     begin
  2348.     if CURRENT_LEVEL = NESTING_DEPTH then
  2349.         raise NESTING_LEVEL_EXCEEDED;
  2350.     else
  2351.         CURRENT_LEVEL := CURRENT_LEVEL + 1;
  2352.         TEXT_IO.OPEN(FD(CURRENT_LEVEL), TEXT_IO.IN_FILE,
  2353.           FILE_NAME.CONTENT(2..FILE_NAME.LAST));
  2354.     end if;
  2355.     exception
  2356.     when TEXT_IO.NAME_ERROR =>
  2357.         TEXT_IO.PUT_LINE("Include File " &
  2358.           LINE_DEFINITION.CONVERT(FILE_NAME) &
  2359.               " not Found");
  2360.         raise FILE_NOT_FOUND;
  2361.     when others =>
  2362.         TEXT_IO.PUT_LINE("Unexpected error with Include File " &
  2363.           LINE_DEFINITION.CONVERT(FILE_NAME));
  2364.         raise FILE_NOT_FOUND;
  2365.     end OPEN;
  2366.  
  2367.     procedure OPEN(FILE_NAME : in STRING) is
  2368.     begin
  2369.     OPEN(LINE_DEFINITION.CONVERT(FILE_NAME));
  2370.     end OPEN;
  2371.  
  2372.     -- Close the include file
  2373.     -- Exceptions which may be raised: FILE_NOT_OPEN
  2374.     procedure CLOSE is
  2375.     begin
  2376.     TEXT_IO.CLOSE(FD(CURRENT_LEVEL));
  2377.     CURRENT_LEVEL := CURRENT_LEVEL - 1;
  2378.     if CURRENT_LEVEL = 0 then
  2379.         raise INCLUDE_FILE_EMPTY;
  2380.     end if;
  2381.     end CLOSE;
  2382.  
  2383.     -- Abort processing the include file
  2384.     procedure STOP is
  2385.     begin
  2386.     while CURRENT_LEVEL > 0 loop
  2387.         TEXT_IO.CLOSE(FD(CURRENT_LEVEL));
  2388.         CURRENT_LEVEL := CURRENT_LEVEL - 1;
  2389.     end loop;
  2390.     end STOP;
  2391.  
  2392.     -- Read a LINE containing a file name from the include file
  2393.     -- Exceptions which may be raised: FILE_NOT_OPEN, READ_PAST_END_OF_FILE
  2394.     procedure READ(TO : out LINE_DEFINITION.LINE) is
  2395.     INLINE : LINE_DEFINITION.LINE;
  2396.     begin
  2397.     loop
  2398.         begin
  2399.         TEXT_IO.GET_LINE(FD(CURRENT_LEVEL), INLINE.CONTENT,
  2400.           INLINE.LAST);
  2401.         if INLINE.LAST > 0 and INLINE.CONTENT(1) =
  2402.           INCLUDE_CHARACTER then
  2403.             OPEN(INLINE);
  2404.         elsif (INLINE.LAST > 0 and INLINE.CONTENT(1) = COMMENT_CHARACTER) or
  2405.           (INLINE.LAST = 0) then
  2406.             null;    -- skip comment lines and empty lines
  2407.         else
  2408.             exit;
  2409.         end if;
  2410.         exception
  2411.         when TEXT_IO.END_ERROR =>
  2412.             CLOSE;
  2413.         end;
  2414.     end loop;
  2415.     TO := INLINE;
  2416.     end READ;
  2417.  
  2418. end INCLUDE_FILE;
  2419.  
  2420. --===========================================================================
  2421. ---------------------------- PROCEDURE PARSER -------------------------------
  2422. --===========================================================================
  2423. -- PARSER parses a LINE and returns the number of tokens in that LINE
  2424. -- and the first token as COMMAND (converted to lower-case) with the
  2425. -- rest of the tokens in ARGS (a linked list of argument LINEs)
  2426.  
  2427. with LINE_DEFINITION;
  2428. use  LINE_DEFINITION;
  2429. procedure PARSER(INLINE  : in LINE_DEFINITION.LINE;
  2430.          NARGS   : out NATURAL;
  2431.          COMMAND : out LINE_DEFINITION.LINE;
  2432.          ARGS    : in out LINE_DEFINITION.LINE_LIST) is
  2433.  
  2434.     ROVER    : NATURAL;
  2435.     LROVER   : LINE_DEFINITION.LINE_LIST := null;
  2436.     LFIRST   : LINE_DEFINITION.LINE_LIST := null;
  2437.     LCOMMAND : LINE_DEFINITION.LINE;
  2438.     LTEMP    : LINE_DEFINITION.LINE;
  2439.     LARGS    : NATURAL                   := 0;
  2440.  
  2441.     procedure SKIP_SPACES is
  2442.     begin
  2443.     while INLINE.CONTENT(ROVER) <= ' ' and ROVER <= INLINE.LAST loop
  2444.         ROVER := ROVER + 1;
  2445.     end loop;
  2446.     end SKIP_SPACES;
  2447.  
  2448.     procedure EXTRACT(ITEM : out LINE_DEFINITION.LINE) is
  2449.     EXTRACT_ROVER : NATURAL := 0;
  2450.     begin
  2451.     while INLINE.CONTENT(ROVER) > ' ' and ROVER <= INLINE.LAST loop
  2452.         EXTRACT_ROVER := EXTRACT_ROVER + 1;
  2453.         ITEM.CONTENT(EXTRACT_ROVER) := INLINE.CONTENT(ROVER);
  2454.         ROVER := ROVER + 1;
  2455.     end loop;
  2456.     ITEM.LAST := EXTRACT_ROVER;
  2457.     end EXTRACT;
  2458.  
  2459. begin
  2460.     COMMAND.LAST := 0;
  2461.     ROVER := INLINE.CONTENT'FIRST;
  2462.     SKIP_SPACES;
  2463.     if ROVER <= INLINE.LAST then
  2464.     EXTRACT(LCOMMAND);
  2465.     LCOMMAND.LAST := LCOMMAND.LAST + 1;
  2466.     LCOMMAND.CONTENT(LCOMMAND.LAST) := ' ';
  2467.     COMMAND := LINE_DEFINITION.TOLOWER(LCOMMAND);
  2468.     LARGS := 1;
  2469.         LROVER := ARGS;
  2470.     while ROVER <= INLINE.LAST loop
  2471.         SKIP_SPACES;
  2472.         if ROVER <= INLINE.LAST then
  2473.         EXTRACT(LTEMP);
  2474.         if ARGS = null then
  2475.             ARGS := new LINE_DEFINITION.LINE_LIST_ELEMENT;
  2476.             LROVER := ARGS;
  2477.             LROVER.NEXT := null;
  2478.         end if;
  2479.         LROVER.CONTENT := LTEMP;
  2480.         LARGS := LARGS + 1;
  2481.                 if LROVER.NEXT = null then
  2482.                     LROVER.NEXT := new LINE_DEFINITION.LINE_LIST_ELEMENT;
  2483.                 end if;
  2484.                 LROVER := LROVER.NEXT;
  2485.         end if;
  2486.     end loop;
  2487.     end if;
  2488.     NARGS := LARGS;
  2489. end PARSER;
  2490.  
  2491. --===========================================================================
  2492. ---------------------------- PACKAGE PAGED_FILE -----------------------------
  2493. --===========================================================================
  2494. with LINE_DEFINITION;
  2495. package PAGED_FILE is
  2496.  
  2497.     procedure COMPUTE_CHECKSUM (NARGS   : in NATURAL;
  2498.                                 ARGLIST : in LINE_DEFINITION.LINE_LIST);
  2499.     -- Compute the checksum of a paged file
  2500.  
  2501.     procedure MAKE_INCLUDE_FILE (NARGS   : in NATURAL;
  2502.                                  ARGLIST : in LINE_DEFINITION.LINE_LIST);
  2503.     -- Create an include file which names the elements of a paged file
  2504.  
  2505.     procedure LIST (NARGS   : in NATURAL;
  2506.                     ARGLIST : in LINE_DEFINITION.LINE_LIST);
  2507.     -- List the names of the elements of a paged file
  2508.  
  2509.     procedure CREATE (NARGS   : in NATURAL;
  2510.                       ARGLIST : in LINE_DEFINITION.LINE_LIST);
  2511.     -- Create a paged file
  2512.  
  2513.     procedure UNPAGE (NARGS   : in NATURAL;
  2514.                       ARGLIST : in LINE_DEFINITION.LINE_LIST);
  2515.     -- Extract the elements of a paged file
  2516.  
  2517. end PAGED_FILE;
  2518.  
  2519. with INCLUDE_FILE, INPUT_FILE, OUTPUT_FILE, PARSER;
  2520. with TEXT_IO;
  2521. package body PAGED_FILE is
  2522.  
  2523.     INLINE          : LINE_DEFINITION.LINE;
  2524.  
  2525.     --=======================================================================
  2526.     -- PAGED_FILE, Support Utilities
  2527.     --=======================================================================
  2528.  
  2529.     use  LINE_DEFINITION;
  2530.  
  2531.     -- Determine if ITEM contains a BANNER or COMMENT_BANNER
  2532.     function IS_BANNER(ITEM : in LINE_DEFINITION.LINE) return BOOLEAN is
  2533.     RESULT : BOOLEAN;
  2534.     begin
  2535.     if ITEM.LAST >= LINE_DEFINITION.BANNER'LENGTH and then
  2536.       ITEM.CONTENT(1 .. LINE_DEFINITION.BANNER'LENGTH) =
  2537.       LINE_DEFINITION.BANNER then
  2538.         RESULT := TRUE;
  2539.     elsif ITEM.LAST >= LINE_DEFINITION.COMMENT_BANNER'LENGTH and then
  2540.       ITEM.CONTENT(1 .. LINE_DEFINITION.COMMENT_BANNER'LENGTH) =
  2541.       LINE_DEFINITION.COMMENT_BANNER then
  2542.         RESULT := TRUE;
  2543.     else
  2544.         RESULT := FALSE;
  2545.     end if;
  2546.     return RESULT;
  2547.     end IS_BANNER;
  2548.  
  2549.     -- Package to handle line counting
  2550.     package COUNTER is
  2551.  
  2552.         -- Reset the Counter
  2553.     procedure SET;
  2554.  
  2555.         -- Increment the Counter
  2556.     procedure INCREMENT;
  2557.  
  2558.         -- Print the counter
  2559.     procedure PRINT;
  2560.  
  2561.     end COUNTER;
  2562.  
  2563.     package body COUNTER is
  2564.  
  2565.     type LINE_COUNT is range 0 .. 10001;
  2566.     package LINE_COUNT_IO is new TEXT_IO.INTEGER_IO(LINE_COUNT);
  2567.  
  2568.     LCOUNT : LINE_COUNT;
  2569.  
  2570.         -- Reset the LCOUNT variable
  2571.     procedure SET is
  2572.     begin
  2573.         LCOUNT := 0;
  2574.     end SET;
  2575.  
  2576.         -- Increment the LCOUNT variable
  2577.     procedure INCREMENT is
  2578.     begin
  2579.         if LCOUNT < LINE_COUNT'LAST then
  2580.         LCOUNT := LCOUNT + 1;
  2581.         end if;
  2582.     end INCREMENT;
  2583.  
  2584.         -- Print a count of the number of lines and reset the LCOUNT variable
  2585.     procedure PRINT is
  2586.     begin
  2587.         TEXT_IO.PUT(" -- ");
  2588.         if LCOUNT = LINE_COUNT'LAST then
  2589.         TEXT_IO.PUT("More Than" & LINE_COUNT'IMAGE(LINE_COUNT'LAST -
  2590.           1));
  2591.         else
  2592.         LINE_COUNT_IO.PUT(LCOUNT, 1);
  2593.         end if;
  2594.         TEXT_IO.PUT_LINE(" Lines");
  2595.         LCOUNT := 0;
  2596.     end PRINT;
  2597.  
  2598.     end COUNTER;
  2599.  
  2600.     --=======================================================================
  2601.     -- PAGED_FILE, COMPUTE_CHECKSUM Command
  2602.     --=======================================================================
  2603.     procedure COMPUTE_CHECKSUM (NARGS   : in NATURAL;
  2604.                                 ARGLIST : in LINE_DEFINITION.LINE_LIST) is
  2605.     CHECKSUM : INTEGER;
  2606.     package VALUE_IO is new TEXT_IO.INTEGER_IO(INTEGER);
  2607.     begin
  2608.     if NARGS = 1 then
  2609.         TEXT_IO.PUT_LINE(" CHECK Command requires the name of a file");
  2610.         TEXT_IO.PUT_LINE("   Syntax: list file_name");
  2611.     else
  2612.  
  2613.             -- Step 1: Open the input file
  2614.         INPUT_FILE.OPEN(ARGLIST.CONTENT);
  2615.  
  2616.             -- Step 2: Compute the Hash (Checksum)
  2617.         CHECKSUM := 0;
  2618.         while not INPUT_FILE.END_OF_FILE loop
  2619.         INPUT_FILE.READ(INLINE);
  2620.         for I in 1 .. INLINE.LAST loop
  2621.             if INLINE.CONTENT(I) > ' ' then
  2622.             CHECKSUM := CHECKSUM +
  2623.               CHARACTER'POS(INLINE.CONTENT(I));
  2624.             if CHECKSUM >= 128 then
  2625.                 CHECKSUM := CHECKSUM - 128;
  2626.             end if;
  2627.             end if;
  2628.         end loop;
  2629.         end loop;
  2630.         INPUT_FILE.CLOSE;
  2631.  
  2632.             -- Step 3: Print the result
  2633.         TEXT_IO.PUT(" Pager Checksum (Hash) of " &
  2634.           LINE_DEFINITION.CONVERT(ARGLIST.CONTENT) & " is ");
  2635.         VALUE_IO.PUT(CHECKSUM, 1);
  2636.         TEXT_IO.NEW_LINE;
  2637.  
  2638.     end if;
  2639.  
  2640.     exception
  2641.     when INPUT_FILE.FILE_NOT_FOUND =>
  2642.             TEXT_IO.PUT(" CHECK:");
  2643.         TEXT_IO.PUT_LINE(" File " &
  2644.               LINE_DEFINITION.CONVERT(ARGLIST.CONTENT) &
  2645.           " not Found");
  2646.     when INPUT_FILE.READ_PAST_END_OF_FILE =>
  2647.             TEXT_IO.PUT(" CHECK:");
  2648.         TEXT_IO.PUT_LINE(" Premature EOF on " &
  2649.           LINE_DEFINITION.CONVERT(ARGLIST.CONTENT));
  2650.         INPUT_FILE.CLOSE;
  2651.     when others =>
  2652.             TEXT_IO.PUT(" CHECK:");
  2653.         TEXT_IO.PUT_LINE(" Unexpected Error");
  2654.         INPUT_FILE.CLOSE;
  2655.  
  2656.     end COMPUTE_CHECKSUM;
  2657.  
  2658.     --=======================================================================
  2659.     -- PAGED_FILE, MAKE_INCLUDE_FILE Command
  2660.     --=======================================================================
  2661.     procedure MAKE_INCLUDE_FILE (NARGS   : in NATURAL;
  2662.                                  ARGLIST : in LINE_DEFINITION.LINE_LIST) is
  2663.     IN_FILE   : BOOLEAN;
  2664.         ARG_ROVER : LINE_DEFINITION.LINE_LIST;
  2665.     begin
  2666.     if NARGS < 3 then
  2667.         TEXT_IO.PUT_LINE
  2668.               (" INCLUDE Command requires the name of a paged file");
  2669.         TEXT_IO.PUT_LINE
  2670.               ("   Syntax: include paged_file_name output_include_file");
  2671.     else
  2672.  
  2673.             -- Step 1: Open the input and output files
  2674.         COUNTER.SET;
  2675.         ARG_ROVER := ARGLIST.NEXT;
  2676.         INPUT_FILE.OPEN(ARGLIST.CONTENT);
  2677.         OUTPUT_FILE.OPEN(ARG_ROVER.CONTENT);
  2678.         OUTPUT_FILE.WRITE("-- Include file for " &
  2679.           LINE_DEFINITION.CONVERT(ARGLIST.CONTENT));
  2680.  
  2681.             -- Step 2: Look for the first banner in the paged file
  2682.         IN_FILE := TRUE;
  2683.         while not INPUT_FILE.END_OF_FILE loop
  2684.         INPUT_FILE.READ(INLINE);
  2685.         if IS_BANNER(INLINE) then
  2686.             IN_FILE := FALSE;
  2687.             exit;
  2688.         end if;
  2689.         end loop;
  2690.  
  2691.             -- Step 3: If first banner not found, issue error message,
  2692.             --         else process component files
  2693.         if IN_FILE then
  2694.         TEXT_IO.PUT_LINE
  2695.                   (" File " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT) &
  2696.           " does not contain any components");
  2697.         else
  2698.  
  2699.                 -- Loop until the end of the input paged file
  2700.         while not INPUT_FILE.END_OF_FILE loop
  2701.  
  2702.                     -- Read the next line from the input paged file
  2703.             INPUT_FILE.READ(INLINE);
  2704.  
  2705.                     -- If we are not in the text of the file, the line just
  2706.                     -- read contains the name of a new file, else it contains
  2707.                     -- a line of the current component file
  2708.             if not IN_FILE then
  2709.  
  2710.                     -- Remove leading comment character if any and print the
  2711.                     -- name of the component file
  2712.             if INLINE.CONTENT(1 .. 2) = "--" then
  2713.                 TEXT_IO.PUT(" " &
  2714.                   INLINE.CONTENT(3 .. INLINE.LAST));
  2715.                 OUTPUT_FILE.WRITE
  2716.                               (INLINE.CONTENT(3 .. INLINE.LAST));
  2717.             else
  2718.                 TEXT_IO.PUT(" " &
  2719.                   INLINE.CONTENT(1 .. INLINE.LAST));
  2720.                 OUTPUT_FILE.WRITE
  2721.                               (INLINE.CONTENT(1 .. INLINE.LAST));
  2722.             end if;
  2723.  
  2724.                         -- Flush the trailing banner line and note that we are
  2725.                         -- now within the text of a component file
  2726.             INPUT_FILE.READ(INLINE);
  2727.             COUNTER.SET;
  2728.             IN_FILE := TRUE;
  2729.  
  2730.             else
  2731.  
  2732.                     -- We are within the text of a component file, so check
  2733.                     -- for a banner in order to determine if we are at the end
  2734.                     -- of the component file
  2735.             if IS_BANNER(INLINE) then
  2736.                 IN_FILE := FALSE;
  2737.                 COUNTER.PRINT;
  2738.             else
  2739.                 COUNTER.INCREMENT;
  2740.             end if;
  2741.  
  2742.             end if;
  2743.  
  2744.         end loop;
  2745.  
  2746.         end if;
  2747.  
  2748.         COUNTER.PRINT;
  2749.         INPUT_FILE.CLOSE;
  2750.         OUTPUT_FILE.CLOSE;
  2751.  
  2752.     end if;
  2753.  
  2754.     exception
  2755.     when OUTPUT_FILE.CANNOT_CREATE_FILE =>
  2756.             TEXT_IO.PUT(" INCLUDE:");
  2757.         TEXT_IO.PUT_LINE(" Cannot create " &
  2758.           LINE_DEFINITION.CONVERT(ARG_ROVER.CONTENT));
  2759.     when INPUT_FILE.FILE_NOT_FOUND =>
  2760.             TEXT_IO.PUT(" INCLUDE:");
  2761.         TEXT_IO.PUT_LINE
  2762.               (" File " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT) &
  2763.           " not Found");
  2764.     when INPUT_FILE.READ_PAST_END_OF_FILE =>
  2765.             TEXT_IO.PUT(" INCLUDE:");
  2766.         TEXT_IO.PUT_LINE(" Premature EOF on " &
  2767.           LINE_DEFINITION.CONVERT(ARGLIST.CONTENT));
  2768.         INPUT_FILE.CLOSE;
  2769.     when others =>
  2770.             TEXT_IO.PUT(" INCLUDE:");
  2771.         TEXT_IO.PUT_LINE(" Unexpected Error");
  2772.         INPUT_FILE.CLOSE;
  2773.  
  2774.     end MAKE_INCLUDE_FILE;
  2775.  
  2776.     --=======================================================================
  2777.     -- PAGED_FILE, LIST Command
  2778.     --=======================================================================
  2779.     procedure LIST (NARGS   : in NATURAL;
  2780.                     ARGLIST : in LINE_DEFINITION.LINE_LIST) is
  2781.     IN_FILE : BOOLEAN;
  2782.     begin
  2783.     if NARGS = 1 then
  2784.         TEXT_IO.PUT_LINE
  2785.               (" LIST Command requires the name of a paged file");
  2786.         TEXT_IO.PUT_LINE
  2787.               ("   Syntax: list paged_file_name");
  2788.     else
  2789.  
  2790.             -- Step 1: Open the input file
  2791.         COUNTER.SET;
  2792.         INPUT_FILE.OPEN(ARGLIST.CONTENT);
  2793.  
  2794.             -- Step 2: Look for the first banner in the paged file
  2795.         IN_FILE := TRUE;
  2796.         while not INPUT_FILE.END_OF_FILE loop
  2797.         INPUT_FILE.READ(INLINE);
  2798.         if IS_BANNER(INLINE) then
  2799.             IN_FILE := FALSE;
  2800.             exit;
  2801.         end if;
  2802.         end loop;
  2803.  
  2804.             -- Step 3: If first banner not found, issue error message,
  2805.             --         else process component files
  2806.         if IN_FILE then
  2807.         TEXT_IO.PUT_LINE
  2808.                   (" File " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT) &
  2809.           " does not contain any components");
  2810.         else
  2811.  
  2812.                 -- Loop until the end of the input paged file
  2813.         while not INPUT_FILE.END_OF_FILE loop
  2814.  
  2815.                     -- Read the next line from the input paged file
  2816.             INPUT_FILE.READ(INLINE);
  2817.  
  2818.                     -- If we are not in the text of the file, the line just
  2819.                     -- read contains the name of a new file, else it contains
  2820.                     -- a line of the current component file
  2821.             if not IN_FILE then
  2822.  
  2823.                         -- Remove leading comment character if any and print
  2824.                         -- the name of the component file
  2825.             if INLINE.CONTENT(1 .. 2) = "--" then
  2826.                 TEXT_IO.PUT(" " &
  2827.                   INLINE.CONTENT(3 .. INLINE.LAST));
  2828.             else
  2829.                 TEXT_IO.PUT(" " &
  2830.                   INLINE.CONTENT(1 .. INLINE.LAST));
  2831.             end if;
  2832.  
  2833.                         -- Flush the trailing banner line and note that we are
  2834.                         -- now within the text of a component file
  2835.             INPUT_FILE.READ(INLINE);
  2836.             COUNTER.SET;
  2837.             IN_FILE := TRUE;
  2838.  
  2839.             else
  2840.  
  2841.                         -- We are within the text of a component file, so
  2842.                         -- check for a banner in order to determine if we
  2843.                         -- are at the end of the component file
  2844.             if IS_BANNER(INLINE) then
  2845.                 IN_FILE := FALSE;
  2846.                 COUNTER.PRINT;
  2847.             else
  2848.                 COUNTER.INCREMENT;
  2849.             end if;
  2850.  
  2851.             end if;
  2852.  
  2853.         end loop;
  2854.  
  2855.         end if;
  2856.  
  2857.         COUNTER.PRINT;
  2858.         INPUT_FILE.CLOSE;
  2859.  
  2860.     end if;
  2861.  
  2862.     exception
  2863.     when INPUT_FILE.FILE_NOT_FOUND =>
  2864.             TEXT_IO.PUT(" LIST:");
  2865.         TEXT_IO.PUT_LINE
  2866.               (" File " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT) &
  2867.           " not Found");
  2868.     when INPUT_FILE.READ_PAST_END_OF_FILE =>
  2869.             TEXT_IO.PUT(" LIST:");
  2870.         TEXT_IO.PUT_LINE(" Premature EOF on " &
  2871.           LINE_DEFINITION.CONVERT(ARGLIST.CONTENT));
  2872.         INPUT_FILE.CLOSE;
  2873.     when others =>
  2874.             TEXT_IO.PUT(" LIST:");
  2875.         TEXT_IO.PUT_LINE(" Unexpected Error");
  2876.         INPUT_FILE.CLOSE;
  2877.  
  2878.     end LIST;
  2879.  
  2880.     --=======================================================================
  2881.     -- PAGED_FILE, CREATE Command
  2882.     --=======================================================================
  2883.     procedure CREATE (NARGS   : in NATURAL;
  2884.                       ARGLIST : in LINE_DEFINITION.LINE_LIST) is
  2885.     COMPONENT_FILE_NAME : LINE_DEFINITION.LINE;
  2886.     OUTPUT_FILE_NAME    : LINE_DEFINITION.LINE;
  2887.         ARG_ROVER           : LINE_DEFINITION.LINE_LIST;
  2888.     begin
  2889.     if NARGS < 3 then
  2890.         TEXT_IO.PUT_LINE
  2891.               (" PAGE Command requires the name of the paged file and include file");
  2892.         TEXT_IO.PUT_LINE
  2893.               ("   Syntax: page [@include_file_name|file_name]+ paged_file_name");
  2894.     else
  2895.         ARG_ROVER := ARGLIST;
  2896.             for I in 1 .. NARGS-2 loop
  2897.         ARG_ROVER := ARG_ROVER.NEXT;
  2898.         end loop;
  2899.         OUTPUT_FILE_NAME := ARG_ROVER.CONTENT;
  2900.         OUTPUT_FILE.OPEN(OUTPUT_FILE_NAME);
  2901.         ARG_ROVER := ARGLIST;
  2902.         for I in 1 .. NARGS-2 loop
  2903.         if ARG_ROVER.CONTENT.CONTENT(1) =
  2904.           INCLUDE_FILE.INCLUDE_CHARACTER then
  2905.             INCLUDE_FILE.OPEN
  2906.                       (LINE_DEFINITION.CONVERT(ARG_ROVER.CONTENT));
  2907.             begin
  2908.             loop
  2909.                 INCLUDE_FILE.READ(COMPONENT_FILE_NAME);
  2910.                 INPUT_FILE.OPEN(COMPONENT_FILE_NAME);
  2911.                 OUTPUT_FILE.WRITE(LINE_DEFINITION.COMMENT_BANNER);
  2912.                 OUTPUT_FILE.WRITE("--" &
  2913.                   LINE_DEFINITION.CONVERT(COMPONENT_FILE_NAME));
  2914.                 OUTPUT_FILE.WRITE(LINE_DEFINITION.COMMENT_BANNER);
  2915.                 TEXT_IO.PUT(" Adding " &
  2916.                   LINE_DEFINITION.CONVERT(COMPONENT_FILE_NAME));
  2917.                 COUNTER.SET;
  2918.                 while not INPUT_FILE.END_OF_FILE loop
  2919.                 INPUT_FILE.READ(INLINE);
  2920.                 OUTPUT_FILE.WRITE(INLINE);
  2921.                 COUNTER.INCREMENT;
  2922.                 end loop;
  2923.                 COUNTER.PRINT;
  2924.                 INPUT_FILE.CLOSE;
  2925.             end loop;
  2926.             exception
  2927.             when INCLUDE_FILE.READ_PAST_END_OF_FILE |
  2928.               INCLUDE_FILE.INCLUDE_FILE_EMPTY |
  2929.                           INCLUDE_FILE.NESTING_LEVEL_EXCEEDED =>
  2930.                             INCLUDE_FILE.STOP;
  2931.             when INPUT_FILE.FILE_NOT_FOUND =>
  2932.                 TEXT_IO.PUT_LINE(" File " &
  2933.                   LINE_DEFINITION.CONVERT(COMPONENT_FILE_NAME) &
  2934.                   " not Found");
  2935.                 INCLUDE_FILE.STOP;
  2936.             when others =>
  2937.                 TEXT_IO.PUT_LINE
  2938.                               (" Unexpected Error During Processing " &
  2939.                               "of Component File " &
  2940.                   LINE_DEFINITION.CONVERT(COMPONENT_FILE_NAME));
  2941.                 INCLUDE_FILE.STOP;
  2942.             end;
  2943.         else
  2944.             INPUT_FILE.OPEN(ARG_ROVER.CONTENT);
  2945.             OUTPUT_FILE.WRITE(LINE_DEFINITION.COMMENT_BANNER);
  2946.             OUTPUT_FILE.WRITE("--" &
  2947.               LINE_DEFINITION.CONVERT(ARG_ROVER.CONTENT));
  2948.             OUTPUT_FILE.WRITE(LINE_DEFINITION.COMMENT_BANNER);
  2949.             TEXT_IO.PUT(" Adding " &
  2950.               LINE_DEFINITION.CONVERT(ARG_ROVER.CONTENT));
  2951.             COUNTER.SET;
  2952.             while not INPUT_FILE.END_OF_FILE loop
  2953.             INPUT_FILE.READ(INLINE);
  2954.             OUTPUT_FILE.WRITE(INLINE);
  2955.             COUNTER.INCREMENT;
  2956.             end loop;
  2957.             COUNTER.PRINT;
  2958.             INPUT_FILE.CLOSE;
  2959.         end if;
  2960.                 ARG_ROVER := ARG_ROVER.NEXT;
  2961.         end loop;
  2962.             OUTPUT_FILE.CLOSE;
  2963.     end if;
  2964.  
  2965.     exception
  2966.     when OUTPUT_FILE.CANNOT_CREATE_FILE =>
  2967.             TEXT_IO.PUT(" PAGE:");
  2968.         TEXT_IO.PUT_LINE(" Cannot create " &
  2969.           LINE_DEFINITION.CONVERT(OUTPUT_FILE_NAME));
  2970.     when INCLUDE_FILE.FILE_NOT_FOUND =>
  2971.             TEXT_IO.PUT(" PAGE:");
  2972.         TEXT_IO.PUT_LINE(" Cannot open include file");
  2973.     when others =>
  2974.             TEXT_IO.PUT(" PAGE:");
  2975.         TEXT_IO.PUT_LINE(" Unexpected Error");
  2976.         INPUT_FILE.CLOSE;
  2977.  
  2978.     end CREATE;
  2979.  
  2980.     --=======================================================================
  2981.     -- PAGED_FILE, UNPAGE Command
  2982.     --=======================================================================
  2983.     procedure UNPAGE (NARGS   : in NATURAL;
  2984.                       ARGLIST : in LINE_DEFINITION.LINE_LIST) is
  2985.     IN_FILE          : BOOLEAN;
  2986.     OUTPUT_FILE_NAME : LINE_DEFINITION.LINE;
  2987.     begin
  2988.     if NARGS = 1 then
  2989.         TEXT_IO.PUT_LINE
  2990.               (" UNPAGE Command requires the name of a paged file");
  2991.         TEXT_IO.PUT_LINE("   Syntax: unpage paged_file_name");
  2992.     else
  2993.  
  2994.             -- Step 1: Open the input file
  2995.         COUNTER.SET;
  2996.         INPUT_FILE.OPEN(ARGLIST.CONTENT);
  2997.  
  2998.             -- Step 2: Look for the first banner in the paged file
  2999.         IN_FILE := TRUE;
  3000.         while not INPUT_FILE.END_OF_FILE loop
  3001.         INPUT_FILE.READ(INLINE);
  3002.         if IS_BANNER(INLINE) then
  3003.             IN_FILE := FALSE;
  3004.             exit;
  3005.         end if;
  3006.         end loop;
  3007.  
  3008.             -- Step 3: If first banner not found, issue error message,
  3009.             --         else process component files
  3010.         if IN_FILE then
  3011.         TEXT_IO.PUT_LINE(" File " &
  3012.                   LINE_DEFINITION.CONVERT(ARGLIST.CONTENT) &
  3013.           " does not contain any components");
  3014.         else
  3015.  
  3016.                 -- Loop until the end of the input paged file
  3017.         while not INPUT_FILE.END_OF_FILE loop
  3018.  
  3019.                     -- Read the next line from the input paged file
  3020.             INPUT_FILE.READ(INLINE);
  3021.  
  3022.                     -- If we are not in the text of the file, the line just
  3023.                     -- read contains the name of a new file, else it contains
  3024.                     -- a line of the current component file
  3025.             if not IN_FILE then
  3026.  
  3027.                         -- Remove leading comment character if any and
  3028.                         -- store the name of the component file
  3029.             if INLINE.CONTENT(1 .. 2) = "--" then
  3030.                 OUTPUT_FILE_NAME :=
  3031.                   LINE_DEFINITION.CONVERT
  3032.                                 (INLINE.CONTENT(3 .. INLINE.LAST));
  3033.             else
  3034.                 OUTPUT_FILE_NAME :=
  3035.                   LINE_DEFINITION.CONVERT
  3036.                                 (INLINE.CONTENT(1 .. INLINE.LAST));
  3037.             end if;
  3038.  
  3039.                         -- Open the new component file
  3040.             OUTPUT_FILE.OPEN(OUTPUT_FILE_NAME);
  3041.             TEXT_IO.PUT(" Extracting " &
  3042.               LINE_DEFINITION.CONVERT(OUTPUT_FILE_NAME));
  3043.  
  3044.                         -- Flush the trailing banner line and note that we are
  3045.                         -- now within the text of a component file
  3046.             INPUT_FILE.READ(INLINE);
  3047.             IN_FILE := TRUE;
  3048.             COUNTER.SET;
  3049.  
  3050.             else
  3051.  
  3052.                         -- We are within the text of a component file, so
  3053.                         -- check for a banner in order to determine if we
  3054.                         -- are at the end of the component file
  3055.             if IS_BANNER(INLINE) then
  3056.                 OUTPUT_FILE.CLOSE;
  3057.                 IN_FILE := FALSE;
  3058.                 COUNTER.PRINT;
  3059.             else
  3060.                 OUTPUT_FILE.WRITE(INLINE);
  3061.                 COUNTER.INCREMENT;
  3062.             end if;
  3063.  
  3064.             end if;
  3065.  
  3066.         end loop;
  3067.  
  3068.         OUTPUT_FILE.CLOSE;
  3069.  
  3070.         end if;
  3071.  
  3072.         COUNTER.PRINT;
  3073.         INPUT_FILE.CLOSE;
  3074.  
  3075.     end if;
  3076.  
  3077.     exception
  3078.     when OUTPUT_FILE.CANNOT_CREATE_FILE =>
  3079.             TEXT_IO.PUT(" UNPAGE:");
  3080.         TEXT_IO.PUT_LINE(" Cannot create " &
  3081.           LINE_DEFINITION.CONVERT(OUTPUT_FILE_NAME));
  3082.     when INPUT_FILE.FILE_NOT_FOUND =>
  3083.             TEXT_IO.PUT(" UNPAGE:");
  3084.         TEXT_IO.PUT_LINE(" File " &
  3085.               LINE_DEFINITION.CONVERT(ARGLIST.CONTENT) &
  3086.           " not Found");
  3087.     when INPUT_FILE.READ_PAST_END_OF_FILE =>
  3088.             TEXT_IO.PUT(" UNPAGE:");
  3089.         TEXT_IO.PUT_LINE(" Premature EOF on " &
  3090.           LINE_DEFINITION.CONVERT(ARGLIST.CONTENT));
  3091.         INPUT_FILE.CLOSE;
  3092.     when others =>
  3093.             TEXT_IO.PUT(" UNPAGE:");
  3094.         TEXT_IO.PUT_LINE(" Unexpected Error");
  3095.         INPUT_FILE.CLOSE;
  3096.  
  3097.     end UNPAGE;
  3098.  
  3099. end PAGED_FILE;
  3100.  
  3101. --===========================================================================
  3102. --------------------------------- MAINLINE ----------------------------------
  3103. --===========================================================================
  3104. with LINE_DEFINITION, PAGED_FILE, PARSER;
  3105. use  LINE_DEFINITION;
  3106. with TEXT_IO;
  3107. with CLI;
  3108. procedure PAGER2 is
  3109.  
  3110.     TITLE           : constant STRING := "PAGER2, Ada Version 1.1";
  3111.  
  3112.     INLINE          : LINE_DEFINITION.LINE;
  3113.  
  3114.     NARGS           : NATURAL;
  3115.     COMMAND         : LINE_DEFINITION.LINE;
  3116.     ARGLIST         : LINE_DEFINITION.LINE_LIST;
  3117.     ARG_ROVER       : LINE_DEFINITION.LINE_LIST;
  3118.  
  3119.     -- Command Verbs
  3120.     HELP_COMMAND    : constant STRING := "help ";
  3121.     H_COMMAND       : constant STRING := "h ";
  3122.     EXIT_COMMAND    : constant STRING := "exit ";
  3123.     X_COMMAND       : constant STRING := "x ";    -- same as exit
  3124.     CHECK_COMMAND   : constant STRING := "check ";
  3125.     C_COMMAND       : constant STRING := "c ";    -- same as check
  3126.     INCLUDE_COMMAND : constant STRING := "include ";
  3127.     I_COMMAND       : constant STRING := "i ";    -- same as include
  3128.     LIST_COMMAND    : constant STRING := "list ";
  3129.     L_COMMAND       : constant STRING := "l ";    -- same as list
  3130.     PAGE_COMMAND    : constant STRING := "page ";
  3131.     P_COMMAND       : constant STRING := "p ";    -- same as page
  3132.     UNPAGE_COMMAND  : constant STRING := "unpage ";
  3133.     U_COMMAND       : constant STRING := "u ";    -- same as unpage
  3134.  
  3135.     --=======================================================================
  3136.     -- PAGER2, Support Utilities
  3137.     --=======================================================================
  3138.  
  3139.     -- Determine if COMMAND contains one of the two target command strings
  3140.     function IS_COMMAND(TARGET1_COMMAND, TARGET2_COMMAND : in STRING)
  3141.             return BOOLEAN is
  3142.         START : NATURAL;
  3143.     begin
  3144.         if COMMAND.CONTENT(1) = '-' then
  3145.             START := 2;
  3146.         else
  3147.             START := 1;
  3148.         end if;
  3149.     if COMMAND.CONTENT(START .. TARGET1_COMMAND'LENGTH + START - 1)
  3150.               = TARGET1_COMMAND or
  3151.       COMMAND.CONTENT(START .. TARGET2_COMMAND'LENGTH + START - 1)
  3152.               = TARGET2_COMMAND then
  3153.         return TRUE;
  3154.     else
  3155.         return FALSE;
  3156.     end if;
  3157.     end IS_COMMAND;
  3158.  
  3159.     --=======================================================================
  3160.     -- PAGER2, HELP Command
  3161.     --=======================================================================
  3162.     procedure HELP is
  3163.     procedure SPACER is
  3164.     begin
  3165.         TEXT_IO.PUT("                  ");
  3166.     end SPACER;
  3167.     begin
  3168.     TEXT_IO.PUT_LINE(" Command Summary");
  3169.     TEXT_IO.PUT_LINE("  help or h   - this summary");
  3170.     SPACER;
  3171.     TEXT_IO.PUT_LINE("Syntax: help");
  3172.     TEXT_IO.PUT_LINE("  exit or x   - exit from program");
  3173.     SPACER;
  3174.     TEXT_IO.PUT_LINE("Syntax: exit");
  3175.     TEXT_IO.PUT_LINE
  3176.           ("  include or i- list components into an include file");
  3177.     SPACER;
  3178.     TEXT_IO.PUT_LINE
  3179.           ("Syntax: include paged_file_name output_include_file");
  3180.     TEXT_IO.PUT_LINE("  list or l   - list components of paged file");
  3181.     SPACER;
  3182.     TEXT_IO.PUT_LINE("Syntax: list paged_file_name");
  3183.     TEXT_IO.PUT_LINE
  3184.           ("  page or p   - create paged file from include file");
  3185.     SPACER;
  3186.     TEXT_IO.PUT_LINE
  3187.           ("Syntax: page [@include_file_name|file_name]+ paged_file_name");
  3188.     TEXT_IO.PUT_LINE
  3189.           ("  unpage or u - extract components from paged file");
  3190.     SPACER;
  3191.     TEXT_IO.PUT_LINE("Syntax: unpage paged_file_name");
  3192.     end HELP;
  3193.  
  3194. --=======================================================================
  3195. -- PAGER2, Mainline
  3196. --=======================================================================
  3197. begin
  3198.     CLI.INITIALIZE ("PAGER2", "Enter verb and arguments: ");
  3199.  
  3200.     -- Interactive mode if no arguments
  3201.     if CLI.ARGC = 1 then
  3202.     TEXT_IO.PUT_LINE(TITLE);
  3203.     TEXT_IO.PUT_LINE("Type 'h' for Help");
  3204.     loop
  3205.         begin
  3206.         TEXT_IO.PUT("PAGER2> ");
  3207.         TEXT_IO.GET_LINE(INLINE.CONTENT, INLINE.LAST);
  3208.         PARSER(INLINE, NARGS, COMMAND, ARGLIST);
  3209.         if NARGS > 0 then
  3210.             exit when IS_COMMAND(EXIT_COMMAND, X_COMMAND);
  3211.             if IS_COMMAND(HELP_COMMAND, H_COMMAND) then
  3212.             HELP;
  3213.             elsif IS_COMMAND(CHECK_COMMAND, C_COMMAND) then
  3214.             PAGED_FILE.COMPUTE_CHECKSUM (NARGS, ARGLIST);
  3215.             elsif IS_COMMAND(INCLUDE_COMMAND, I_COMMAND) then
  3216.             PAGED_FILE.MAKE_INCLUDE_FILE (NARGS, ARGLIST);
  3217.             elsif IS_COMMAND(LIST_COMMAND, L_COMMAND) then
  3218.             PAGED_FILE.LIST (NARGS, ARGLIST);
  3219.             elsif IS_COMMAND(PAGE_COMMAND, P_COMMAND) then
  3220.             PAGED_FILE.CREATE (NARGS, ARGLIST);
  3221.             elsif IS_COMMAND(UNPAGE_COMMAND, U_COMMAND) then
  3222.             PAGED_FILE.UNPAGE (NARGS, ARGLIST);
  3223.             else
  3224.             TEXT_IO.PUT_LINE(" Invalid Command: " &
  3225.               LINE_DEFINITION.CONVERT(COMMAND));
  3226.             end if;
  3227.         end if;
  3228.         exception
  3229.         when others =>
  3230.             null;
  3231.         end;
  3232.     end loop;
  3233.     -- Non-interactive mode if one or more arguments
  3234.     else
  3235.     COMMAND := TOLOWER(LINE_DEFINITION.CONVERT(CLI.ARGV(1) & " "));
  3236.     NARGS := CLI.ARGC - 1;
  3237.     ARGLIST := null;
  3238.     for I in 2 .. CLI.ARGC - 1 loop
  3239.         if I = 2 then
  3240.         ARGLIST := new LINE_DEFINITION.LINE_LIST_ELEMENT;
  3241.         ARG_ROVER := ARGLIST;
  3242.         else
  3243.         ARG_ROVER.NEXT := new LINE_DEFINITION.LINE_LIST_ELEMENT;
  3244.         ARG_ROVER := ARG_ROVER.NEXT;
  3245.         end if;
  3246.         ARG_ROVER.NEXT := null;
  3247.         ARG_ROVER.CONTENT := LINE_DEFINITION.CONVERT(CLI.ARGV(I));
  3248.     end loop;
  3249.     if NARGS > 0 then
  3250.         if IS_COMMAND(HELP_COMMAND, H_COMMAND) then
  3251.         HELP;
  3252.         elsif IS_COMMAND(CHECK_COMMAND, C_COMMAND) then
  3253.         PAGED_FILE.COMPUTE_CHECKSUM (NARGS, ARGLIST);
  3254.         elsif IS_COMMAND(INCLUDE_COMMAND, I_COMMAND) then
  3255.         PAGED_FILE.MAKE_INCLUDE_FILE (NARGS, ARGLIST);
  3256.         elsif IS_COMMAND(LIST_COMMAND, L_COMMAND) then
  3257.         PAGED_FILE.LIST (NARGS, ARGLIST);
  3258.         elsif IS_COMMAND(PAGE_COMMAND, P_COMMAND) then
  3259.         PAGED_FILE.CREATE (NARGS, ARGLIST);
  3260.         elsif IS_COMMAND(UNPAGE_COMMAND, U_COMMAND) then
  3261.         PAGED_FILE.UNPAGE (NARGS, ARGLIST);
  3262.         elsif IS_COMMAND(EXIT_COMMAND, X_COMMAND) then
  3263.         null;
  3264.         else
  3265.         TEXT_IO.PUT_LINE(" Invalid Command: " &
  3266.           LINE_DEFINITION.CONVERT(COMMAND));
  3267.         end if;
  3268.     end if;
  3269.     end if;
  3270. exception
  3271.     when others =>
  3272.     null;
  3273. end PAGER2;
  3274.